.IF DF L$$GCL .IFF ; DF L$$GCL .TITLE DRPFN Logical Name Directives .IDENT /X.X/ .IFT ; DF L$$GCL .NLIST .ENABL LC .NLIST BIN,LOC .LIST ; 0001 0 %TITLE 'Logical Name Directives' ; 0002 0 MODULE DRPFN (IDENT = 'X1.12' ; 0003 0 ) = ; 0004 1 BEGIN ; Copyright (c) 1995-1999 by Mentec, Inc., U.S.A. ; All rights reserved ; ; 0008 1 ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ; 0009 1 ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ; 0010 1 ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ; 0011 1 ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ; 0012 1 ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ; 0013 1 ! TRANSFERRED. ; 0014 1 ! ; 0015 1 ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ; 0016 1 ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ; 0017 1 ! CORPORATION. ; 0018 1 ! ; 0019 1 ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; 0020 1 ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ; 0021 1 ; 0022 1 !++ ; 0023 1 ! FACILITY: ; 0024 1 ! RSX-11M-PLUS executive ; 0025 1 ! ; 0026 1 ! ABSTRACT: ; 0027 1 ! Provide the directives that support the use of logical names, ; 0028 1 ! particularly in relation to file operations. ; 0029 1 ! ; 0030 1 ! ENVIRONMENT: ; 0031 1 ! Kernel Mode, priority 0, called by directive dispatcher, resident ; 0032 1 ! in directive common, overmapped I and D spaces ; 0033 1 ! ; 0034 1 ! AUTHORs: ; 0035 1 ! Tony Lekas ; 0036 1 ! Michael Pettengill ; 0037 1 ! ; 0038 1 ! CREATION DATE: 16-JUN-1984 ; 0039 1 ! ; 0040 1 ! MODIFIED FOR M-PLUS V 3.0 BY: ; 0041 1 ! ; 0042 1 ! Paul K. M. Weiss ; 0043 1 ! ; 0044 1 ! Modified by: ; 0045 1 ! ; 0046 1 ! Paul K. M. Weiss 8-Apr-1986 1.09 ; 0047 1 ! ; 0048 1 ! PKW111 - Don't crash on a parse of _ ; 0049 1 ! PKW112 - Don't remove all zeros from version # in FCS default ; 0050 1 ! Don't return version # of -1 in FCS default as 177777 ; 0051 1 ! ; 0052 1 ! Paul K. M. Weiss 8-Aug-1986 1.10 ; 0053 1 ! ; 0054 1 ! PKW117 - Don't clear FS$QUO when a node is separated for ; 0055 1 ! logical expansion ; 0056 1 ! ; 0057 1 ! Paul K. M. Weiss 24-May-1988 1.11 ; 0058 1 ! ; 0059 1 ! PKW156 - Don't crash if dev in primary and node in secondary ; 0060 1 ! ; 0061 1 ! Modified for RSX-11M-PLUS V4.4 by: ; 0062 1 ! ; 0063 1 ! J. C. Franzini 26-Sep-1990 X1.12 ; 0064 1 ! JCF400 -- Fix PKW156 to return correct flags for secondary ; 0065 1 ! Wildcard flags were being lost ; 0066 1 !-- ; 0067 1 ; 0068 1 ! ; 0069 1 ! INCLUDE FILES: ; 0070 1 ! ; 0071 1 LIBRARY 'BLI:RSX11M'; ; 0072 1 LIBRARY 'BLI:FCS11'; ; 0073 1 ! ; 0074 1 ! MACROS: ; 0075 1 ! ; 0076 1 MACRO ; 0077 1 ! ; 0078 1 ! Set directive status and exit ; 0079 1 ! ; M 0080 1 ERROR_EXIT (error_code) = ; M 0081 1 BEGIN ; M 0082 1 LINKAGE ; M 0083 1 error_trap = TRAP; ; M 0084 1 error_trap (error_code AND %o'377') ; 0085 1 END %; ; 0086 1 ; 0087 1 MACRO ; 0088 1 ! ; 0089 1 ! Move a character string. Advance the pointers. ; 0090 1 ! ; M 0091 1 ch$move (len, ip, op) = ; M 0092 1 BEGIN ; M 0093 1 ; M 0094 1 MAP ; M 0095 1 ip : REF VECTOR [,BYTE], ; M 0096 1 op : REF VECTOR [,BYTE]; ; M 0097 1 ; M 0098 1 IF len NEQU 0 ; M 0099 1 THEN ; M 0100 1 DECR i FROM len TO 1 DO ; M 0101 1 BEGIN ; M 0102 1 op [0] = .ip [0]; ; M 0103 1 op = op [1]; ; M 0104 1 ip = ip [1]; ; M 0105 1 END; ; M 0106 1 ; 0107 1 END; %; ; 0108 1 ; 0109 1 LITERAL ; 0110 1 debug_version = 1; ! Variant type ; 0111 1 ; 0112 1 MACRO ; 0113 1 ! ; 0114 1 ! No /VARIANT switch produces the production version. ; 0115 1 ! /VARIANT produces the debug version with global stuff. ; 0116 1 ! ; M 0117 1 global_for_debug = ; 0118 1 %IF %VARIANT EQLU debug_version %THEN GLOBAL %FI %, ; M 0119 1 global_for_debug_own_otherwise = ; 0120 1 %IF %VARIANT EQLU debug_version %THEN GLOBAL %ELSE OWN %FI%, ; M 0121 1 external_debug_forward_else = ; 0122 1 %IF %VARIANT EQLU debug_version %THEN EXTERNAL %ELSE FORWARD %FI%, ; M 0123 1 find_something = ; M 0124 1 %IF %VARIANT EQLU debug_version ; M 0125 1 %THEN ; M 0126 1 find_test ; M 0127 1 %ELSE ; M 0128 1 find_equivalence ; 0129 1 %FI%; ; 0130 1 ! ; 0131 1 ! LINKAGES ; 0132 1 ! ; 0133 1 LINKAGE ; 0134 1 $LNxxx_l = JSR (REGISTER = 3, REGISTER = 4, REGISTER = 5) : NOPRESERVE (0, 1, 2, 3, 4, 5), ; 0135 1 common_parse_l = JSR (REGISTER = 3, REGISTER = 4, REGISTER = 5, REGISTER = 0), ; 0136 1 sec_spec_convert_l = JSR (REGISTER = 3, REGISTER = 4; REGISTER = 3), ; 0137 1 return_ie_xxx_l = JSR : PRESERVE (0, 1, 2, 3, 4, 5), ; 0138 1 lun_assign_l = JSR (REGISTER = 3, REGISTER = 4, REGISTER = 5, REGISTER = 0, REGISTER = 1, ; 0139 1 REGISTER = 2; REGISTER = 1) : NOPRESERVE (0, 1, 2, 3, 4, 5), ; 0140 1 find_equivalence_l = JSR (REGISTER = 1, REGISTER = 2; REGISTER = 1, REGISTER = 2), ; 0141 1 fss_l = JSR (REGISTER = 4, REGISTER = 5; REGISTER = 4, REGISTER = 5), ; 0142 1 expand_filespec_l = JSR (REGISTER = 3), ; 0143 1 separate_logical_l = JSR (REGISTER = 3, REGISTER = 4), ; 0144 1 ch$classify_l = JSR (REGISTER = 1), ; 0145 1 ch$copy_l = JSR (REGISTER = 1, REGISTER = 2, REGISTER = 3; REGISTER = 3) : NOPRESERVE (0, 1, 2) ; 0146 1 PRESERVE (4, 5), ; 0147 1 save_parse_l = JSR (REGISTER = 1) : NOPRESERVE (0, 1, 2), ; 0148 1 RAD50_to_ASCII_l = JSR (REGISTER = 1, REGISTER = 2, REGISTER = 3; REGISTER = 2); ; 0149 1 ; 0150 1 ! ; 0151 1 ! TABLE OF CONTENTS: ; 0152 1 ! ; 0153 1 FORWARD ROUTINE ; 0154 1 $LNFSS : $LNxxx_l NOVALUE, ! File Specification Scan, called from DRLOG ; 0155 1 $LNCHN : $LNxxx_l NOVALUE, ! Assign channel, called from DRLOG ; 0156 1 $LNRMS : $LNxxx_l NOVALUE, ! RMS format parse, called from DRLOG ; 0157 1 $LNFCS : $LNxxx_l NOVALUE, ! FCS format parse, called from DRLOG ; 0158 1 common_parse : common_parse_l NOVALUE, ! Parse code common to RMS and FCS parse ; 0159 1 fss : fss_l NOVALUE, ! Utility routine to parse a file specification ; 0160 1 expand_filespec : expand_filespec_l, ! Expand a file specification with logicals ; 0161 1 ch$classify : ch$classify_l, ! Classify the character ; 0162 1 ch$copy : ch$copy_l NOVALUE, ! Copy, upcase, and compress a string ; 0163 1 convert_parse : NOVALUE, ! Convert addresses in parse block to user virtual ; 0164 1 merge, ! Merge primary and secondary file specifications ; 0165 1 save_parse : save_parse_l NOVALUE, ! Save and zero parse block ; 0166 1 RAD50_to_ASCII : RAD50_to_ASCII_l NOVALUE; ! Convert RAD50 to ASCII ; 0167 1 EXTERNAL_DEBUG_FORWARD_ELSE ROUTINE ; 0168 1 find_equivalence : find_equivalence_l; ! Find equivalence for logical name ; 0169 1 ; 0170 1 ! ; 0171 1 ! EQUATED SYMBOLS: ; 0172 1 ! ; 0173 1 LITERAL ; 0174 1 true = 1, ; 0175 1 false = 0, ; 0176 1 valid = 1, ; 0177 1 success = 1, ; 0178 1 terminal = 3, ; 0179 1 error = 0, ; 0180 1 bad_node = -1176, ! ER$NOD ; 0181 1 bad_device = -448, ! ER$DEV ; 0182 1 bad_directory = -464, ! ER$DIR ; 0183 1 bad_filename = -752, ! ER$FNM ; 0184 1 bad_char = -1824, ! ER$XTR ; 0185 1 bad_logical = -184, ! ER$BEQ ; 0186 1 bad_recursive = -1688, ! ER$TRN ; 0187 1 bad_size = -780; ! ER$FTB ; 0188 1 ; 0189 1 LITERAL ; 0190 1 apr5_v = %o'120000', ! APR 5 virtual address ; 0191 1 apr6_v = %o'140000'; ! APR 6 virtual address ; 0192 1 ; 0193 1 LITERAL ! Character types ; 0194 1 ch_other = 0, ! All other characters ; 0195 1 ch_lower = 1, ! Lowercase ; 0196 1 ch_space = 2, ! Spaces ; 0197 1 ch_oct = 3, ! Octal Number ; 0198 1 ch_alpha = 4, ! Alphabetic ; 0199 1 ch_comma = 5, ! Comma ; 0200 1 ch_colon = 6, ! Colon ; 0201 1 ch_quote = 7, ! "Double" quote ; 0202 1 ch_dir = 8, ! Matching directory bracket ; 0203 1 ch_wild = 9, ! Wildcards, star and percent ; 0204 1 ch_dash = 10, ! Dash ; 0205 1 ch_dot = 11, ! Dot ; 0206 1 ch_dollar = 12, ! Dollar sign ; 0207 1 ch_under = 13, ! Underscore ; 0208 1 ch_8and9 = 14, ! Non octal digits ; 0209 1 ch_misc = 15, ! Miscellaneous valid characters ; 0210 1 ch_valid = 2, ! Minimum valid character type ; 0211 1 ch_max = 15; ! Maximum character type ; 0212 1 ; 0213 1 ! ; 0214 1 ! These are from FSS$BT in RMSMAC.MLB. They are defined ; 0215 1 ! here for convience. ; 0216 1 ! ; 0217 1 LITERAL ; 0218 1 FS$VER = %o'1', ; 0219 1 FS$TYP = %o'2', ; 0220 1 FS$NAM = %o'4', ; 0221 1 FS$WVE = %o'10', ; 0222 1 FS$WTY = %o'20', ; 0223 1 FS$WNA = %o'40', ; 0224 1 FS$DIR = %o'100', ; 0225 1 FS$DEV = %o'200', ; 0226 1 FS$NOD = %o'400', ; 0227 1 FS$WDI = %o'1000', ; 0228 1 FS$QUO = %o'2000', ; 0229 1 FS$WCH = %o'4000', ; 0230 1 FS$NDF = %o'10000'; ; 0231 1 ; 0232 1 LITERAL ; 0233 1 logical_type_none = 0, ! Values for parse_block_f ; 0234 1 logical_type_filename = 1, ! field logical_type ; 0235 1 logical_type_device = 2, ; 0236 1 logical_type_node = 3; ; 0237 1 ; 0238 1 FIELD ; 0239 1 parse_block_f = ; 0240 1 SET ; 0241 1 fss_status = [0, 0, 16, 0], ! Status of operation ; 0242 1 flags = [1, 0, 16, 0], ! Flag word ; 0243 1 node_len = [2, 0, 16, 0], ! Length of node specification ; 0244 1 node_addr = [3, 0, 16, 0], ! Address of node specification ; 0245 1 device_len = [4, 0, 16, 0], ! Length of device specification ; 0246 1 device_addr = [5, 0, 16, 0], ! Address of device specification ; 0247 1 directory_len = [6, 0, 16, 0], ! Length of filename specification ; 0248 1 directory_addr = [7, 0, 16, 0], ! Address of filename specification ; 0249 1 filename_len = [8, 0, 16, 0], ! Length of filename specification ; 0250 1 filename_addr = [9, 0, 16, 0], ! Address of filename specification ; 0251 1 type_len = [10, 0, 16, 0], ! Length of type specification ; 0252 1 type_addr = [11, 0, 16, 0], ! Address of type specification ; 0253 1 version_len = [12, 0, 16, 0], ! Length of version specification ; 0254 1 version_addr = [13, 0, 16, 0], ! Address of version specification ; 0255 1 trailing_len = [14, 0, 16, 0], ! Length of trailing string ; 0256 1 trailing_addr = [15, 0, 16, 0], ! Address of trailing string ; 0257 1 access_len = [16, 0, 16, 0], ! Length of access specification ; 0258 1 access_addr = [17, 0, 16, 0], ! Address of access specification ; 0259 1 logical_type = [18, 0, 8, 0], ! First element which could be ; 0260 1 ! a logical ; 0261 1 ! 0 - None ; 0262 1 ! 1 - Filename ; 0263 1 ! 2 - Device ; 0264 1 ! 3 - Node ; 0265 1 reserved_field = [18, 8, 8, 0] ! Reserved ; 0266 1 ; 0267 1 TES; ; 0268 1 ; 0269 1 FIELD ; 0270 1 logical_descriptor_f = ; 0271 1 SET ; 0272 1 length = [0, 0, 16, 0], ! Logical name length in bytes ; 0273 1 address_base = [1, 0, 16, 0], ! 32 word block offset of base ; 0274 1 address_disp_apr6 = [2, 0, 16, 0], ! APR6 displacment of the logical name ; 0275 1 table_number = [3, 0, 8, 0], ! Table number to be searched ; 0276 1 block_type = [3, 8, 8, 0], ! Block type number ; 0277 1 matching_tcb_ucb = [4, 0, 16, 0] ! Matching UCB or TCB depending on table type ; 0278 1 TES; ; 0279 1 ; 0280 1 LITERAL ; 0281 1 file_spec_size = 255, ! Maximum file specification size ; 0282 1 logical_size = 255, ! Maximum size of one logical ; 0283 1 parse_block_size = 19, ! Parse work area size in words ; 0284 1 logical_descriptor_size = 5, ! Logical name descriptor block size in words ; 0285 1 iteration_max = 10; ! Max iteration count ; 0286 1 ; 0287 1 ! ; 0288 1 ! OWN STORAGE (GLOBAL for DEBUG): ; 0289 1 ! ; 0290 1 GLOBAL_FOR_DEBUG_OWN_OTHERWISE ; 0291 1 must_have_device, ! Flag for ACHN$ ; 0292 1 cannot_have_node, ! Node is illegal except for RMS ; 0293 1 terminal_logical_flag, ! Flag for terminal ; 0294 1 do_directory_defaulting, ! Directory defaulting flag ; 0295 1 saved_inhibit_mask, ; 0296 1 init_logical_descriptor : BLOCK [logical_descriptor_size] ; 0297 1 FIELD (logical_descriptor_f), ! Logical name descriptor block ; 0298 1 scr_pb : BLOCK[parse_block_size] ! Scratch buffer for fss ; 0299 1 FIELD (parse_block_f), ! ; 0300 1 pri_pb : BLOCK [parse_block_size] ! Primary file specification ; 0301 1 FIELD (parse_block_f), ! parse block ; 0302 1 merged : REF VECTOR [, BYTE], ! Merged specification buffer ; 0303 1 primary : REF VECTOR [, BYTE], ! Primary specification buffer ; 0304 1 secondary : VECTOR [file_spec_size, BYTE], ! Work area for secondary input to merge ; 0305 1 work_1 : VECTOR [file_spec_size, BYTE], ! Work area ; 0306 1 work_2 : VECTOR [file_spec_size, BYTE]; ! Work area ; 0307 1 ; 0308 1 ! ; 0309 1 ! EXTERNAL REFERENCES: ; 0310 1 ! ; 0311 1 EXTERNAL ; 0312 1 $SAHDB, ! Saved header mapping ; 0313 1 KISAR5, ! Kernel APR 5 actual data space mapping register ; 0314 1 KISAR6, ! Kernel APR 6 actual data space mapping register ; 0315 1 $TONYL, ! Temporary storage for directives ; 0316 1 H_DUIC, ! Default UIC offset in header ; 0317 1 T_UCB, ! TI: UCB address offset in TCB ; 0318 1 T_CTX, ! Task dds context block address ; 0319 1 D_UCB, ! Address of the first UCB for this DCB ; 0320 1 D_UCBL, ! Length of UCBs for this DCB ; 0321 1 D_UNIT, ! Lowest unit on this DCB ; 0322 1 D_NAM, ! Device name for this DCB ; 0323 1 U_CTX, ! Terminal dds context block address ; 0324 1 U_DCB, ! Address of the DCB for this UCB ; 0325 1 U_CW1, ! UCB first characteristics word ; 0326 1 DV_REC, ! Record oriented device (U.CW1) ; 0327 1 DV_SDI, ! Single directory device (U.CW1) ; 0328 1 DV_SQD, ! Sequential device (U.CW1) ; 0329 1 DV_PSE, ! Pseudo device (U.CW1) ; 0330 1 $FMSK4, ! 4th feature mask word address ; 0331 1 F4_DVN; ! Decimal version number flag ; 0332 1 ; 0333 1 LINKAGE ; 0334 1 $ACHxx_l = JSR (REGISTER = 0, REGISTER = 1; REGISTER = 2) : CLEARSTACK VALUECBIT PRESERVE (0, 3, 4, 5) ; 0335 1 NOPRESERVE (1, 2), ; 0336 1 $BLXIO_l = JSR (REGISTER = 0, REGISTER = 1, REGISTER = 2, REGISTER = 3, REGISTER = 4) : PRESERVE (5) ; 0337 1 NOPRESERVE (0, 1, 2, 3, 4), ; 0338 1 $MPLUN_l = JSR (REGISTER = 3, REGISTER = 4, REGISTER = 5; REGISTER = 2) : ; 0339 1 CLEARSTACK VALUECBIT NOPRESERVE (0, 1, 2, 3) PRESERVE (4, 5), ; 0340 1 $MPLND_l = JSR (REGISTER = 0, REGISTER = 5; REGISTER = 0, REGISTER = 2) : ; 0341 1 CLEARSTACK VALUECBIT NOPRESERVE (0, 2) PRESERVE (1, 3, 4, 5), ; 0342 1 $RELOC_l = JSR (REGISTER = 0; REGISTER = 1, REGISTER = 2) : PRESERVE (0, 3, 4, 5) ; 0343 1 NOPRESERVE (1, 2), ; 0344 1 $RELOM_l = JSR (REGISTER = 0) : PRESERVE (3, 4, 5) NOPRESERVE (0, 1, 2), ; 0345 1 $TBSRC_l = JSR (REGISTER = 0; REGISTER = 3) : CLEARSTACK VALUECBIT, ; 0346 1 $DCBTA_l = JSR (REGISTER = 0, REGISTER = 3; REGISTER = 3) : PRESERVE (2, 4, 5) NOPRESERVE (0, 1, 3) ; 0347 1 CLEARSTACK VALUECBIT; ; 0348 1 ; 0349 1 EXTERNAL ROUTINE ; 0350 1 $ACHKB : $ACHxx_l, ! Address check byte aligned read/write ; 0351 1 $ACHRO : $ACHxx_l, ! Address check byte aligned read only ; 0352 1 $BLXIO : $BLXIO_l, ! Block transfer ; 0353 1 $MPLUN : $MPLUN_l, ! Map logical unit number to device ; 0354 1 $MPLND : $MPLND_l, ! Follow unit redirection ; 0355 1 $RELOC : $RELOC_l, ! Relocate user buffer address ; 0356 1 $RELOM : $RELOM_l, ! Relocate and map user buffer ; 0357 1 TBSRC_BLI : $TBSRC_l, ! Search logical name tables ; 0358 1 DCBTA_BLI : $DCBTA_l, ! Binary to octal ASCII routine in DRLOG ; 0359 1 lun_assign : lun_assign_l; ! Routine to assign the LUN ; 0360 1 %SBTTL 'File Specification Scan Directive' ; 0361 1 ; 0362 1 GLOBAL ROUTINE $LNFSS (dpb_ptr, header_addr, tcb_addr) : $LNxxx_l NOVALUE = ; 0363 1 ; 0364 1 !++ ; 0365 1 ! ; 0366 1 ! FUNCTIONAL DESCRIPTION: ; 0367 1 ! ; 0368 1 ! This routine is called by DRLOG if the FSS subfunction was ; 0369 1 ! specified. ; 0370 1 ! ; 0371 1 ! FORMAL PARAMETERS: ; 0372 1 ! ; 0373 1 ! dpb_ptr ; 0374 1 ! Address of the second word of the dpb ; 0375 1 ! ; 0376 1 ! IMPLICIT INPUTS: ; 0377 1 ! ; 0378 1 ! the dpb ; 0379 1 ! The Directive Parameter Block provides all the user ; 0380 1 ! supplied calling parameters ; 0381 1 ! ; 0382 1 ! IMPLICIT OUTPUTS: ; 0383 1 ! ; 0384 1 ! The directive is performed or an error indicating the reason ; 0385 1 ! is returned. ; 0386 1 ! ; 0387 1 !-- ; 0388 1 ; 0389 2 BEGIN ; 0390 2 ! ; 0391 2 ! The File Specification Scanner DPB has the following format: ; 0392 2 ! word contents ; 0393 2 ! ---- -------- ; 0394 2 ! 0 Directive code, DPB length ; 0395 2 ! 1 Subfunction, reserved ; 0396 2 ! 2 Reserved ; 0397 2 ! 3 Address of file specification buffer ; 0398 2 ! 4 Size of file specification buffer ; 0399 2 ! 5 Address of parse block ; 0400 2 ! 6 Size of parse block (in bytes) ; 0401 2 ! ; 0402 2 ! The parse block will zeroed and filled in with descriptors ; 0403 2 ! for each field present of node, access, device, directory, ; 0404 2 ! filename, type, and version, plus the trailing portion of ; 0405 2 ! the string if any. The flags word will be have a bit set for ; 0406 2 ! each of the components present in the format for the RMS ; 0407 2 ! NAM block. ; 0408 2 ! ; 0409 2 ! In more detail. ; 0410 2 ! ; 0411 2 ! NODE: The node includes all nodes if poor man's routing is ; 0412 2 ! is being used. The initial node name is terminated ; 0413 2 ! by the access control string address, even if there ; 0414 2 ! is none. (In this case the access control length is ; 0415 2 ! zero.) ; 0416 2 ! ; 0417 2 ! FS$NOD is set if present. ; 0418 2 ! ; 0419 2 ! ACCESS The access control string is the entire quoted string ; 0420 2 ! CONTROL: terminated by double colon. As noted above, the address ; 0421 2 ! of the access control serves a dual purpose. ; 0422 2 ! ; 0423 2 ! DEVICE: The device is the string terminated by a single colon. ; 0424 2 ! ; 0425 2 ! FS$DEV is set if present. ; 0426 2 ! ; 0427 2 ! DIRECTORY:The directory is the string bounded by either [] or ; 0428 2 ! <> and includes a rather loosely checked set of ; 0429 2 ! characters valid in a directory specification including ; 0430 2 ! wildcards, hierarchies, etc. The syntax of the directory ; 0431 2 ! must be checked for validity in the context of the ; 0432 2 ! operation, for example, network access. ; 0433 2 ! ; 0434 2 ! FS$DIR is set if present. In addition, if wildcards ; 0435 2 ! are found, FS$WDI is also set. (Wildcards are "%", "*", ; 0436 2 ! and "...". ; 0437 2 ! ; 0438 2 ! FILENAME: The filename is the string terminated by ".", ";", or ; 0439 2 ! the end of the file specification. ; 0440 2 ! ; 0441 2 ! FS$NAM is set if present. In addition, if wildcards ; 0442 2 ! are found, FS$WNA is also set. (Wildcards are "%" and ; 0443 2 ! "*".) ; 0444 2 ! ; 0445 2 ! If FS$QUO is set, the file specification is ; 0446 2 ! a quoted string. This is either a "foreign" filespec ; 0447 2 ! if being passed to another system (eg. via DAP) or ; 0448 2 ! an ANSI filespec. The the case of the ANSI file, ; 0449 2 ! a version is allowed, but no type field. In the case ; 0450 2 ! of a network operation, it's ambiguous, but a version ; 0451 2 ! will be allowed but not defaulted. (Actually this ; 0452 2 ! doesn't relate to FSS but this seems to be as good ; 0453 2 ! a place to mention it as any.) ; 0454 2 ! ; 0455 2 ! TYPE: The type is the string terminated by a "." or ";" or ; 0456 2 ! the end of the file specification. A leading "." is ; 0457 2 ! always included in the string. ; 0458 2 ! ; 0459 2 ! FS$TYP is set if present. In addition, if wildcards ; 0460 2 ! are found, FS$WTY is also set. (Wildcards are "%" and ; 0461 2 ! "*".) ; 0462 2 ! ; 0463 2 ! If the filename is a quoted string, then this field ; 0464 2 ! must be null. ; 0465 2 ! ; 0466 2 ! VERSION: The version is the field including a leading "." or ; 0467 2 ! ";" terminated by the end of the string. The string ; 0468 2 ! is limited to an optional leading "-" and the digits ; 0469 2 ! zero to nine, or a "*" wildcard. ; 0470 2 ! ; 0471 2 ! FS$VER is set if present. In addition, if a wildcard ; 0472 2 ! is found, FS$WVE is also set. ; 0473 2 ! ; 0474 2 ! TRAILING: The unparsed portion of the initial string is that part ; 0475 2 ! of the input that was successfully and completely ; 0476 2 ! parsed. If an error is detected in the directory ; 0477 2 ! specification, for example, the trailing string will ; 0478 2 ! include the erroneous directory specification. ; 0479 2 ! ; 0480 2 ! This should allow the used of FSS$ in command line ; 0481 2 ! parsing. Any character not part of a file specification ; 0482 2 ! terminates the scan and results in all information ; 0483 2 ! obtained so far to be returned. ; 0484 2 ! ; 0485 2 ! The field trailing_addr should always be filled in ; 0486 2 ! even when the length is zero. This is different ; 0487 2 ! from the norm, but is an exception for much the ; 0488 2 ! same reason as for access_addr. ; 0489 2 ! ; 0490 2 ! The parse block can be truncated by the user if not all fields ; 0491 2 ! are desired, although the organization isn't well setup for that. ; 0492 2 ! The directive can also be enhanced by adding fields on the end. ; 0493 2 ! Does this code return an error...it shouldn't. ; 0494 2 ! ; 0495 2 ! As coded, the parse block is zeroed and then filled in with the ; 0496 2 ! data from the specified string. This block is then relocated ; 0497 2 ! to the user string virtual address and returned. ; 0498 2 ! ; 0499 2 ; 0500 2 MAP ; 0501 2 dpb_ptr : REF VECTOR; ! Treat the DPB as a vector ; 0502 2 ; 0503 2 LOCAL ; 0504 2 status, ; 0505 2 b_len, ! Buffer length ; 0506 2 b_addr, ! Buffer address ; 0507 2 b_mapping, ! Buffer mapping ; 0508 2 p : REF VECTOR; ! Temporary pointer ; 0509 2 ; 0510 2 b_addr = .dpb_ptr [2]; ! Get buffer address ; 0511 2 IF .b_addr EQLU 0 THEN ERROR_EXIT (IE_ADP); ; 0512 2 b_len = .dpb_ptr [3]; ! Get buffer length ; 0513 2 IF .b_len EQLU 0 OR .b_len GTRU 1024*8 - 64 THEN ERROR_EXIT (IE_IBS); ; 0514 2 ; 0515 2 ! ; 0516 2 ! Address check, relocate, and map the user buffer. No operation ; 0517 2 ! will unmap the user buffer for the duration. The user string ; 0518 2 ! is then parsed and the output parse block is returned. ; 0519 2 ! ; 0520 2 IF $ACHRO (.b_addr, .b_len) THEN ERROR_EXIT (IE_ADP); ! Check for read access ; 0521 2 ; 0522 2 p = $RELOM (.b_addr); ! Map user buffer ; 0523 2 fss (.p, .b_len); ! Parse file specification ; 0524 2 convert_parse (scr_pb, .p, .b_addr); ! Convert parse block addresses to user mode ; 0525 2 ; 0526 2 b_addr = .dpb_ptr [4]; ! Get buffer address ; 0527 2 IF .b_addr EQLU 0 THEN ERROR_EXIT (IE_ADP); ; 0528 2 b_len = .dpb_ptr [5]; ! Get buffer length ; 0529 2 IF .b_len EQLU 0 THEN ERROR_EXIT (IE_IBS); ; 0530 2 ; 0531 2 ! ; 0532 2 ! Address check and relocate the user buffer. Then copy the ; 0533 2 ! parse block to it. ; 0534 2 ! ; 0535 2 IF $ACHKB (.b_addr, .b_len) THEN ERROR_EXIT (IE_ADP); ! Check for read/write access ; 0536 2 ; 0537 2 $RELOC (.b_addr; b_mapping, b_addr); ! Relocte user buffer ; 0538 2 $BLXIO (MINU (parse_block_size*2, .b_len), .kisar5, scr_pb, .b_mapping, .b_addr); ! Move it ; 0539 2 RETURN ; 0540 1 END; .NLIST .LIST BIN,LOC .LIST .TITLE DRPFN Logical Name Directives .IDENT /X1.12/ .PSECT $OWN$, D MUST.HAVE.DEVICE: .BLKW 1 CANNOT.HAVE.NODE: .BLKW 1 TERMINAL.LOGICAL.FLAG: .BLKW 1 DO.DIRECTORY.DEFAULTING: .BLKW 1 SAVED.INHIBIT.MASK: .BLKW 1 INIT.LOGICAL.DESCRIPTOR: .BLKW 5 SCR.PB: .BLKW 23 PRI.PB: .BLKW 23 MERGED: .BLKW 1 PRIMARY:.BLKW 1 SECONDARY: .BLKB 377 .EVEN WORK.1: .BLKB 377 .EVEN WORK.2: .BLKB 377 .GLOBL $SAHDB, KISAR5, KISAR6, $TONYL .GLOBL H.DUIC, T.UCB, T.CTX, D.UCB, D.UCBL .GLOBL D.UNIT, D.NAM, U.CTX, U.DCB, U.CW1 .GLOBL DV.REC, DV.SDI, DV.SQD, DV.PSE .GLOBL $FMSK4, F4.DVN, $ACHKB, $ACHRO .GLOBL $BLXIO, $MPLUN, $MPLND, $RELOC .GLOBL $RELOM, TBSRC.BLI, DCBTA.BLI, LUN.ASSIGN .SBTTL $LNFSS File Specification Scan Directive .PSECT $CODE$, RO .NLIST .ENABL LSB .LIST $LNFSS::TST -(SP) ; 0362 MOV 4(R3),-(SP) ; *(DPB.PTR),B.ADDR 0510 BNE 1$ ; 0511 TRAP 236 1$: MOV 6(R3),2(SP) ; *(DPB.PTR),B.LEN 0512 BEQ 2$ ; 0513 CMP 2(SP),#17700 ; B.LEN,* BLOS 3$ 2$: TRAP 247 3$: MOV (SP),R0 ; B.ADDR,* 0520 MOV 2(SP),R1 ; B.LEN,* JSR PC,$ACHRO BHIS 4$ TRAP 236 4$: MOV (SP),R0 ; B.ADDR,* 0522 JSR PC,$RELOM MOV R0,R1 ; *,P MOV R1,R4 ; P,* 0523 MOV 2(SP),R5 ; B.LEN,* JSR PC,FSS MOV #SCR.PB,-(SP) ; 0524 MOV R1,-(SP) ; P,* MOV 4(SP),-(SP) ; B.ADDR,* JSR PC,CONVERT.PARSE MOV 10(R3),6(SP) ; *(DPB.PTR),B.ADDR 0526 BNE 5$ ; 0527 TRAP 236 5$: MOV 12(R3),10(SP) ; *(DPB.PTR),B.LEN 0528 BNE 6$ ; 0529 TRAP 247 6$: MOV 6(SP),R0 ; B.ADDR,* 0535 MOV 10(SP),R1 ; B.LEN,* JSR PC,$ACHKB BHIS 7$ TRAP 236 7$: MOV 6(SP),R0 ; B.ADDR,* 0537 JSR PC,$RELOC MOV R1,R3 MOV R2,6(SP) MOV 10(SP),R0 ; B.LEN,* 0538 CMP R0,#46 BLOS 8$ MOV #46,R0 8$: MOV KISAR5,R1 MOV #SCR.PB,R2 MOV 6(SP),R4 ; B.ADDR,* JSR PC,$BLXIO ADD #12,SP ; 0362 RTS PC ; Routine Size: 80 words, Routine Base: $CODE$ + 0000 ; Maximum stack depth per invocation: 7 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 0541 1 %SBTTL 'Assign Channel Directive' ; 0542 1 ; 0543 1 GLOBAL ROUTINE $LNCHN (dpb_ptr, header_addr, tcb_addr) : $LNxxx_l NOVALUE = ; 0544 1 ; 0545 1 !++ ; 0546 1 ! ; 0547 1 ! FUNCTIONAL DESCRIPTION: ; 0548 1 ! ; 0549 1 ! This routine is called by DRLOG if the CHN subfunction was ; 0550 1 ! specified. ; 0551 1 ! ; 0552 1 ! Assign channel does all of the processing of the file ; 0553 1 ! specification that is required to find the actual device ; 0554 1 ! name and then assigns the LUN to that device. ; 0555 1 ! ; 0556 1 ! FORMAL PARAMETERS: ; 0557 1 ! ; 0558 1 ! dpb_ptr ; 0559 1 ! Address of the second word of the dpb ; 0560 1 ! ; 0561 1 ! IMPLICIT INPUTS: ; 0562 1 ! ; 0563 1 ! the dpb ; 0564 1 ! The Directive Parameter Block provides all the user ; 0565 1 ! supplied calling parameters ; 0566 1 ! ; 0567 1 ! Assign Channel (ACHN$) DPB Format: ; 0568 1 ! ; 0569 1 ! WD. 00 -- DIC(207.),DPB Size (5.) ; 0570 1 ! WD. 01 -- Subfunction code (6),Reserved ; 0571 1 ! WD. 02 -- LUN, Table mask ; 0572 1 ! WD. 03 -- Address of file specification ; 0573 1 ! WD. 04 -- Size of file specification ; 0574 1 ! ; 0575 1 ! IMPLICIT OUTPUTS: ; 0576 1 ! ; 0577 1 ! The directive is performed or an error indicating the reason ; 0578 1 ! is returned. ; 0579 1 ! ; 0580 1 !-- ; 0581 1 ; 0582 2 BEGIN ; 0583 2 ! ; 0584 2 ! This directive uses the same code as the RMS and ; 0585 2 ! FCS format parse routines. It only passes the ; 0586 2 ! primary string. ; 0587 2 ! ; 0588 2 ; 0589 2 MAP ; 0590 2 dpb_ptr : REF VECTOR; ! Treat the DPB as a vector ; 0591 2 ; 0592 2 OWN ; 0593 2 temp_dpb : VECTOR [12]; ! Temp dpb for common parse ; 0594 2 ; 0595 2 LOCAL ; 0596 2 temp_dpb_ptr : REF VECTOR; ; 0597 2 ; 0598 2 ! ; 0599 2 ! Define the routine to convert the users default string and put ; 0600 2 ! it into the secondary string. For ACHN there isn't one so we just ; 0601 2 ! put a blank in. ; 0602 2 ! ; 0603 2 ROUTINE achn_convert (b_addr, b_len; p) : sec_spec_convert_l = ; 0604 3 BEGIN ; 0605 3 secondary [0] = %C' '; ! No filespec ; 0606 3 RETURN valid; ! Return ok ; 0607 2 END; .NLIST .LIST BIN,LOC .LIST .PSECT $OWN$, D .EVEN TEMP.DPB: .BLKW 14 .SBTTL ACHN.CONVERT Assign Channel Directive .PSECT $CODE$, RO .NLIST .ENABL LSB .LIST ACHN.CONVERT: MOVB #40,SECONDARY ; 0605 MOV #1,R0 ; 0604 RTS PC ; 0603 ; Routine Size: 6 words, Routine Base: $CODE$ + 0240 ; Maximum stack depth per invocation: 0 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 0608 2 ; 0609 2 ! ; 0610 2 ! Initialize the fake dpb ; 0611 2 ! ; 0612 2 temp_dpb_ptr = temp_dpb [0]; ! Init the pointer ; 0613 2 ; 0614 2 temp_dpb_ptr [0] = .dpb_ptr [0]; ! Modifier for common parse ; 0615 2 temp_dpb_ptr = temp_dpb_ptr [1]; ! Advance the pointers ; 0616 2 dpb_ptr = dpb_ptr [1]; ! ... ; 0617 2 ; 0618 2 temp_dpb_ptr [0] = .dpb_ptr [0]; ! LUN and mask for common parse ; 0619 2 temp_dpb_ptr = temp_dpb_ptr [1]; ! Advance the pointers ; 0620 2 dpb_ptr = dpb_ptr [1]; ! ... ; 0621 2 ; 0622 2 temp_dpb_ptr [0] = .dpb_ptr [0]; ! File spec address for common parse ; 0623 2 temp_dpb_ptr = temp_dpb_ptr [1]; ! Advance the pointers ; 0624 2 dpb_ptr = dpb_ptr [1]; ! ... ; 0625 2 ; 0626 2 temp_dpb_ptr [0] = .dpb_ptr [0]; ! File spec length for common parse ; 0627 2 temp_dpb_ptr = temp_dpb_ptr [1]; ! Advance the pointers ; 0628 2 dpb_ptr = dpb_ptr [1]; ! ... ; 0629 2 ; 0630 2 ! ; 0631 2 ! Zero the unused fields. ; 0632 2 ! ; 0633 2 DECR i FROM 8 TO 1 DO ; 0634 3 BEGIN ; 0635 3 temp_dpb_ptr [0] = 0; ! Zero the field ; 0636 3 temp_dpb_ptr = temp_dpb_ptr [1]; ! Advance the pointer ; 0637 2 END; ; 0638 2 ; 0639 2 ! ; 0640 2 ! Do the parse ; 0641 2 ! ; 0642 2 do_directory_defaulting = false; ! No directory defaulting for ACHN ; 0643 2 must_have_device = true; ! Must have a device for ACHN$ ; 0644 2 cannot_have_node = true; ! Node specification is illegal ; 0645 2 common_parse (temp_dpb, .header_addr, .tcb_addr, achn_convert); ; 0646 2 RETURN; ; 0647 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL $LNCHN Assign Channel Directive .NLIST .ENABL LSB .LIST $LNCHN::MOV #TEMP.DPB,R0 ; *,TEMP.DPB.PTR 0612 MOV (R3)+,(R0)+ ; DPB.PTR,TEMP.DPB.PTR 0614 MOV (R3)+,(R0)+ ; DPB.PTR,TEMP.DPB.PTR 0618 MOV (R3)+,(R0)+ ; DPB.PTR,TEMP.DPB.PTR 0622 MOV (R3)+,(R0)+ ; DPB.PTR,TEMP.DPB.PTR 0626 MOV #10,R1 ; *,I 0633 1$: CLR (R0)+ ; TEMP.DPB.PTR 0635 SOB R1,1$ ; I,* 0633 CLR DO.DIRECTORY.DEFAULTING ; 0642 MOV #1,MUST.HAVE.DEVICE ; 0643 MOV #1,CANNOT.HAVE.NODE ; 0644 MOV #TEMP.DPB,R3 ; 0645 MOV #ACHN.CONVERT,R0 JSR PC,COMMON.PARSE RTS PC ; 0543 ; Routine Size: 25 words, Routine Base: $CODE$ + 0254 ; Maximum stack depth per invocation: 1 word .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 0648 1 %SBTTL 'RMS Format Parse Directive' ; 0649 1 ; 0650 1 GLOBAL ROUTINE $LNRMS (dpb_ptr, header_addr, tcb_addr) : $LNxxx_l NOVALUE = ; 0651 1 ; 0652 1 !++ ; 0653 1 ! ; 0654 1 ! FUNCTIONAL DESCRIPTION: ; 0655 1 ! ; 0656 1 ! This routine is called by DRLOG if the RMS subfunction was ; 0657 1 ! specified. ; 0658 1 ! ; 0659 1 ! FORMAL PARAMETERS: ; 0660 1 ! ; 0661 1 ! dpb_ptr ; 0662 1 ! Address of the second word of the dpb ; 0663 1 ! ; 0664 1 ! IMPLICIT INPUTS: ; 0665 1 ! ; 0666 1 ! the dpb ; 0667 1 ! The Directive Parameter Block provides all the user ; 0668 1 ! supplied calling parameters ; 0669 1 ! ; 0670 1 ! IMPLICIT OUTPUTS: ; 0671 1 ! ; 0672 1 ! The directive is performed or an error indicating the reason ; 0673 1 ! is returned. ; 0674 1 ! ; 0675 1 !-- ; 0676 1 ; 0677 2 BEGIN ; 0678 2 ! ; 0679 2 ! The RMS format parse DPB has the following format: ; 0680 2 ! word contents ; 0681 2 ! ---- -------- ; 0682 2 ! 0 Directive code, DPB length ; 0683 2 ! 1 Subfunction, Modifier ; 0684 2 ! 2 LUN, Table mask ; 0685 2 ! 3 Address of the primary file specification buffer ; 0686 2 ! 4 Size of the primary file specification buffer in bytes ; 0687 2 ! 5 Address of the resultant file specification buffer ; 0688 2 ! 6 Size of the resultant file specification buffer in bytes ; 0689 2 ! 7 Address of a word to receive the resultant string size ; 0690 2 ! 8 Address of the parse block ; 0691 2 ! 9 Size of the parse block in bytes ; 0692 2 ! 10 Address of the default file specification buffer ; 0693 2 ! 11 Size of the default file specification buffer in bytes ; 0694 2 ! ; 0695 2 ! The basic operation of the FCS and RMS format parse ; 0696 2 ! subfunctions is the same. The only difference consists of ; 0697 2 ! differences in the formats of the input and output parameters. ; 0698 2 ! Both formats exists in order to minimize the amount of code that ; 0699 2 ! must be added to the RMS and FCS access methods code. ; 0700 2 ! ; 0701 2 ! The follow operations occur: ; 0702 2 ! ; 0703 2 ! 1. First process the input strings: ; 0704 2 ! ; 0705 2 ! 1. The primary string is copied, compressed, and upcased ; 0706 2 ! from the users buffer to a work buffer. ; 0707 2 ! ; 0708 2 ! 2. The resulting string is parsed. (FSS) ; 0709 2 ! ; 0710 2 ! 3. The resulting string is Expanded. ; 0711 2 ! ; 0712 2 ! 4. The resulting value for logical type, (none, filename, ; 0713 2 ! device, node), is saved. ; 0714 2 ! ; 0715 2 ! 5. The secondary string is copied, compressed, and upcased ; 0716 2 ! from the users buffer to a work buffer. This is somewhat ; 0717 2 ! more involved for the FCS format of the directive. ; 0718 2 ! ; 0719 2 ! 6. The resulting string is parsed. (FSS) ; 0720 2 ! ; 0721 2 ! 7. The processed primary and secondary strings are merged. ; 0722 2 ! ; 0723 2 ! 8. If the resulting value for logical type is greater than the ; 0724 2 ! saved value for the processed primary string then expand ; 0725 2 ! the merged string. ; 0726 2 ! ; 0727 2 ! 9. If a node specification is present then we are all done. ; 0728 2 ! Return the output values. ; 0729 2 ! ; 0730 2 ! ; 0731 2 ! 2. Now do the device defaulting: ; 0732 2 ! ; 0733 2 ! 3. The previous merged string is now the primary string. ; 0734 2 ! ; 0735 2 ! 4. Save the flags word from the parse block. The flags returned ; 0736 2 ! indicate what was supplied from the input strings, not what ; 0737 2 ! is supplied by the system defaults. ; 0738 2 ! ; 0739 2 ! 5. If the LUN is assigned: ; 0740 2 ! ; 0741 2 ! 1. Build a secondary string containing the device ; 0742 2 ! specification from the LUN. ; 0743 2 ! ; 0744 2 ! 2. Also indicate that the LUN must not be assigned at the ; 0745 2 ! end of the directive. Reassigning the LUN will result in ; 0746 2 ! an IO.KIL being issued. ; 0747 2 ! ; 0748 2 ! 3. Merge the primary and the secondary strings. Do not ; 0749 2 ! expand the merged string. We know that we have a real ; 0750 2 ! device name. ; 0751 2 ! ; 0752 2 ! ; 0753 2 ! 6. If the LUN is not assigned: ; 0754 2 ! ; 0755 2 ! 1. Put SY: in the secondary string. ; 0756 2 ! ; 0757 2 ! 2. Merge the primary and secondary strings. ; 0758 2 ! ; 0759 2 ! 3. Expand the merged string. ; 0760 2 ! ; 0761 2 ! ; 0762 2 ! 7. If a node specification is present then we are all done. ; 0763 2 ! Return the output values. ; 0764 2 ! ; 0765 2 ! 8. The previous merged string is now the primary string. ; 0766 2 ! ; 0767 2 ! 9. If there is a non null, ([], <>), directory specification in ; 0768 2 ! the primary string then go on to assign the LUN if ; 0769 2 ! appropriate. ; 0770 2 ! ; 0771 2 ! 10. Directory defaulting: ; 0772 2 ! ; 0773 2 ! 1. If there is a non null default directory string then put ; 0774 2 ! the default directory string in the secondary string. ; 0775 2 ! ; 0776 2 ! 2. Otherwise build a directory specification in the ; 0777 2 ! secondary string from the default UIC. ; 0778 2 ! ; 0779 2 ! 3. Merge the primary and secondary strings and make the ; 0780 2 ! result the primary string. ; 0781 2 ! ; 0782 2 ! ; 0783 2 ! 11. If there is a LUN assigment and if that LUN assigment was ; 0784 2 ! used as the default device then do not assign the LUN. ; 0785 2 ! Otherwise use the device portion of the primary string to ; 0786 2 ! assign the LUN. ; 0787 2 ! ; 0788 2 ! 12. Return the primary string to the expanded string buffer. ; 0789 2 ! Return the parse block for the primary string with the saved ; 0790 2 ! flags to the users parse block. ; 0791 2 ! ; 0792 2 ! 13. All done. ; 0793 2 ! ; 0794 2 ; 0795 2 ! ; 0796 2 ! Define the routine to convert the users default string and put ; 0797 2 ! it into the secondary string. For RMS we just copy, compress and ; 0798 2 ! upcase it. ; 0799 2 ! ; 0800 2 ROUTINE rms_convert (b_addr, b_len; p) : sec_spec_convert_l NOVALUE= ; 0801 3 BEGIN ; 0802 3 IF .b_len GTRU file_spec_size THEN ERROR_EXIT (IE_IBS); ; 0803 3 ch$copy (.b_len, .b_addr, secondary [0]; p); ; 0804 2 END; .NLIST .LIST BIN,LOC .LIST .SBTTL RMS.CONVERT RMS Format Parse Directive .NLIST .ENABL LSB .LIST RMS.CONVERT: JSR R1,$SAVE2 ; 0800 MOV R3,R2 ; *,B.ADDR CMP R4,#377 ; B.LEN,* 0802 BLOS 1$ TRAP 247 1$: MOV R4,R1 ; B.LEN,* 0803 MOV #SECONDARY,R3 JSR PC,CH$COPY RTS PC ; 0800 ; Routine Size: 13 words, Routine Base: $CODE$ + 0336 ; Maximum stack depth per invocation: 5 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 0805 2 ; 0806 2 ! ; 0807 2 ! Do the parse ; 0808 2 ! ; 0809 2 do_directory_defaulting = true; ! Do directory defaulting for RMS ; 0810 2 must_have_device = false; ! Don't need explicit device for $PRMS ; 0811 2 cannot_have_node = false; ! RMS likes nodes just fine ; 0812 2 common_parse (.dpb_ptr, .header_addr, .tcb_addr, rms_convert); ; 0813 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL $LNRMS RMS Format Parse Directive .NLIST .ENABL LSB .LIST $LNRMS::MOV #1,DO.DIRECTORY.DEFAULTING ; 0809 CLR MUST.HAVE.DEVICE ; 0810 CLR CANNOT.HAVE.NODE ; 0811 MOV #RMS.CONVERT,R0 ; 0812 JSR PC,COMMON.PARSE RTS PC ; 0650 ; Routine Size: 12 words, Routine Base: $CODE$ + 0370 ; Maximum stack depth per invocation: 1 word .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 0814 1 %SBTTL 'FCS Format Parse Directive' ; 0815 1 ; 0816 1 GLOBAL ROUTINE $LNFCS (dpb_ptr, header_addr, tcb_addr) : $LNxxx_l NOVALUE = ; 0817 1 ; 0818 1 !++ ; 0819 1 ! ; 0820 1 ! FUNCTIONAL DESCRIPTION: ; 0821 1 ! ; 0822 1 ! This routine is called by DRLOG if the FCS subfunction was ; 0823 1 ! specified. ; 0824 1 ! ; 0825 1 ! FORMAL PARAMETERS: ; 0826 1 ! ; 0827 1 ! dpb_ptr ; 0828 1 ! Address of the second word of the dpb ; 0829 1 ! ; 0830 1 ! IMPLICIT INPUTS: ; 0831 1 ! ; 0832 1 ! the dpb ; 0833 1 ! The Directive Parameter Block provides all the user ; 0834 1 ! supplied calling parameters ; 0835 1 ! ; 0836 1 ! IMPLICIT OUTPUTS: ; 0837 1 ! ; 0838 1 ! The directive is performed or an error indicating the reason ; 0839 1 ! is returned. ; 0840 1 ! ; 0841 1 !-- ; 0842 1 ; 0843 2 BEGIN ; 0844 2 ! ; 0845 2 ! The FCS format parse DPB has the following format: ; 0846 2 ! word contents ; 0847 2 ! ---- -------- ; 0848 2 ! 0 Directive code, DPB length ; 0849 2 ! 1 Subfunction, Modifier ; 0850 2 ! 2 LUN, Table mask ; 0851 2 ! 3 Address of the primary file specification buffer ; 0852 2 ! 4 Size of the primary file specification buffer in bytes ; 0853 2 ! 5 Address of the resultant file specification buffer ; 0854 2 ! 6 Size of the resultant file specification buffer in bytes ; 0855 2 ! 7 Address of a word to receive the resultant string size ; 0856 2 ! 8 Address of the parse block ; 0857 2 ! 9 Size of the parse block in bytes ; 0858 2 ! 10 Address of the default name block ; 0859 2 ! 11 Size of the default name block ; 0860 2 ! ; 0861 2 ! The basic operation of the FCS and RMS format parse ; 0862 2 ! subfunctions is the same. The only difference consists of ; 0863 2 ! differences in the formats of the input and output parameters. ; 0864 2 ! Both formats exists in order to minimize the amount of code that ; 0865 2 ! must be added to the RMS and FCS access methods code. ; 0866 2 ! ; 0867 2 ! See $LNRMS for a discription. ; 0868 2 ! ; 0869 2 ! ; 0870 2 ! Define the routine to convert the users default string and put ; 0871 2 ! it into the secondary string. ; 0872 2 ! ; 0873 2 ROUTINE fcs_convert (b_addr, b_len; p) : sec_spec_convert_l NOVALUE = ; 0874 3 BEGIN ; 0875 3 MACRO ; 0876 3 ; 0877 3 ! ; 0878 3 ! Insert a character into a string. Increment the pointer. ; 0879 3 ! ; M 0880 3 ch$insert (value) = ; M 0881 3 BEGIN ; M 0882 3 p [0] = value; ; M 0883 3 p = p [1]; ; M 0884 3 END ; 0885 3 %; ; 0886 3 ; 0887 3 MAP ; 0888 3 p : REF VECTOR [ ,BYTE]; ; 0889 3 ; 0890 3 BIND ; 0891 3 name_block = .b_addr : NAM$; ; 0892 3 ; 0893 3 ! ; 0894 3 ! It should be the full name block ; 0895 3 ! ; 0896 3 IF .b_len NEQU nam$size*2 THEN ERROR_EXIT (IE_IBS); ; 0897 3 p = secondary [0]; ! Init the pointer ; 0898 3 ; 0899 3 ! ; 0900 3 ! Move the device name and unit number into the string. ; 0901 3 ! ; 0902 3 IF .name_block [N_DVNM] NEQU 0 ; 0903 3 THEN ; 0904 4 BEGIN ; 0905 4 ; 0906 4 ! ; 0907 4 ! Do the name ; 0908 4 ! ; 0909 4 ch$insert (.(name_block [N_DVNM])<0,8>); ! Get the first char ; 0910 4 ch$insert (.(name_block [N_DVNM])<8,8>); ! Get the second char ; 0911 4 ; 0912 4 ! ; 0913 4 ! Do the unit number zero suppressed. ; 0914 4 ! ; 0915 4 DCBTA_BLI (.name_block [N_UNIT], .p; p); ! Get the unit number ; 0916 4 ; 0917 4 ! ; 0918 4 ! Insert the trailing : ; 0919 4 ! ; 0920 4 ch$insert (%C':'); ; 0921 3 END; ; 0922 3 ; 0923 3 ! ; 0924 3 ! Fill in the file name and type. ; 0925 3 ! ; 0926 3 ! Check for ANSII format FNB ; 0927 3 ! ; 0928 3 IF .name_block [NB__ANS] ; 0929 3 THEN ; 0930 4 BEGIN ; 0931 4 LOCAL ; 0932 4 file_p : REF VECTOR [,BYTE]; ! Pointer to ANSII file spec ; 0933 4 ; 0934 4 ! ; 0935 4 ! Process ANSII format FNB ; 0936 4 ! ; 0937 4 ! Move the file name in. ; 0938 4 ! ; 0939 4 ch$insert (%C'"'); ! The opening quote ; 0940 4 ; 0941 4 ! ; 0942 4 ! Get the first 12 characters. ; 0943 4 ! ; 0944 4 file_p = .name_block [N_ANM1]; ! Init the pointer ; 0945 4 DECR i FROM 0 TO 11 DO ; 0946 4 IF .file_p [.i] NEQU 0 ; 0947 4 THEN ; 0948 5 ch$insert (.file_p [.i]) ! Move the character ; 0949 4 ELSE ; 0950 4 EXITLOOP; ; 0951 4 ! ; 0952 4 ! Get the next 6 characters. ; 0953 4 ! ; 0954 4 file_p = .name_block [N_ANM2]; ! Init the pointer ; 0955 4 DECR i FROM 0 TO 5 DO ; 0956 4 IF .file_p [.i] NEQU 0 ; 0957 4 THEN ; 0958 5 ch$insert (.file_p [.i]) ! Move the character ; 0959 4 ELSE ; 0960 4 EXITLOOP; ; 0961 4 ch$insert (%C'"'); ! The trailing quote ; 0962 4 END ; 0963 3 ELSE ; 0964 4 BEGIN ; 0965 4 ! ; 0966 4 ! Process non ANSII format FNB ; 0967 4 ! ; 0968 4 ! Convert the filename from RAD50 and move it into the string. ; 0969 4 ! ; 0970 5 IF (.name_block [N_FNAM] NEQU 0) AND (.(name_block [N_FNAM] + 2) NEQU 0) ; 0971 4 THEN ; 0972 4 RAD50_to_ASCII (9, .p, name_block [N_FNAM]; p); ; 0973 4 ; 0974 4 IF .name_block [N_FTYP] NEQU 0 ; 0975 4 THEN ; 0976 5 BEGIN ; 0977 5 ch$insert (%C'.'); ! Insert the . between name and type ; 0978 5 ! ; 0979 5 ! Convert the filename from RAD50 and move it into the string. ; 0980 5 ! ; 0981 5 RAD50_to_ASCII (3, .p, name_block [N_FTYP]; p); ; 0982 4 END; ; 0983 3 END; ; 0984 3 ; 0985 3 ! ; 0986 3 ! Fill in the version number. ; 0987 3 ! ; 0988 3 IF .name_block [N_FVER] NEQU 0 ; 0989 3 THEN ; 0990 4 BEGIN ; 0991 4 LOCAL ; 0992 4 t : VECTOR [2], ! Temporary for divide ; 0993 4 temp_digits : VECTOR [6, BYTE], ; 0994 4 temp_string_p : REF VECTOR [,BYTE], ; 0995 4 base, ; 0996 4 char; ; 0997 4 ; 0998 4 ch$insert (%C';'); ! Insert the ; to start ; 0999 4 ! ; 1000 4 ! Convert the number. Put it backwards into temp_string. ; 1001 4 ! ; 1002 4 t [1] = 0; ; 1003 4 t [0] = .name_block [N_FVER]; ; 1004 4 temp_string_p = temp_digits [0]; ; 1005 4 base = (IF (.$FMSK4 AND F4_DVN) NEQU 0 THEN 10 ELSE 8); ; 1006 4 ; 1007 4 IF (.t [0] GTRU 32767) THEN !PKW112 ; 1008 5 BEGIN !PKW112 ; 1009 5 ch$insert (%C'-'); !Put in a - sign !PKW112 ; 1010 5 t [0] = 0 -.t [0] !PKW112 ; 1011 4 END; !PKW112 ; 1012 4 ; 1013 4 DECR i FROM 6 TO 1 DO ; 1014 5 BEGIN ; 1015 5 BUILTIN ; 1016 5 EDIV; ; 1017 5 ; 1018 5 EDIV (base, t, t [0], char); !-2 ; 1019 5 temp_string_p [0] = .char + %C'0'; ; 1020 5 temp_string_p = temp_string_p [1]; ; 1021 4 END; !-1 ; 1022 4 ; 1023 4 temp_string_p = temp_string_p [0] - 1; !Back up to last char PKW112 ; 1024 4 ! !PKW112 ; 1025 4 ! Remove any leading zeros. (They're trailing zeros !PKW112 ; 1026 4 ! in temp_string) !PKW112 ; 1027 4 ! !PKW112 ; 1028 4 !PKW112 ; 1029 4 WHILE .temp_string_p [0] EQLU %C'0' DO !PKW112 ; 1030 4 temp_string_p = temp_string_p [0] - 1; !PKW112 ; 1031 4 ; 1032 4 ! ; 1033 4 ! Move the string from temp_string where it is backwards ; 1034 4 ! to the secondary string in the correct order. ; 1035 4 ! ; 1036 4 DECR i FROM temp_string_p [0] TO temp_digits [0] DO ; 1037 5 BEGIN ; 1038 5 ch$insert(.(.i)<0,8>); ; 1039 4 END; ; 1040 3 END; ; 1041 2 END; .NLIST .LIST BIN,LOC .LIST .SBTTL FCS.CONVERT FCS Format Parse Directive .NLIST .ENABL LSB .LIST FCS.CONVERT: MOV R1,-(SP) ; 0873 MOV R2,-(SP) MOV R4,-(SP) MOV R5,-(SP) SUB #14,SP MOV R3,R5 ; *,B.ADDR CMP R4,#36 ; B.LEN,* 0896 BEQ 1$ TRAP 247 1$: MOV #SECONDARY,R4 ; *,P 0897 MOV #32,R0 ; 0902 ADD R5,R0 ; B.ADDR,* TST (R0) BEQ 2$ MOVB (R0),(R4)+ ; *,P 0909 MOVB 1(R0),(R4)+ ; *,P 0910 MOV 34(R5),R0 ; *(B.ADDR),* 0915 MOV R4,R3 ; P,* JSR PC,DCBTA.BLI MOV R3,R4 MOVB #72,(R4)+ ; *,P 0920 2$: BIT #2000,20(R5) ; *,*(B.ADDR) 0928 BEQ 3$ MOVB #42,(R4)+ ; *,P 0939 MOV 24(R5),R0 ; *(B.ADDR),FILE.P 0954 MOVB #42,(R4)+ ; *,P 0961 BR 5$ ; 0928 3$: MOV #6,R3 ; 0970 ADD R5,R3 ; B.ADDR,* TST (R3) BEQ 4$ TST 10(R5) ; *(B.ADDR) BEQ 4$ MOV #11,R1 ; 0972 MOV R4,R2 ; P,* JSR PC,RAD50.TO.ASCII MOV R2,R4 4$: MOV #14,R3 ; 0974 ADD R5,R3 ; B.ADDR,* TST (R3) BEQ 5$ MOVB #56,(R4)+ ; *,P 0977 MOV #3,R1 ; 0981 MOV R4,R2 ; P,* JSR PC,RAD50.TO.ASCII MOV R2,R4 5$: MOV 16(R5),R0 ; *(B.ADDR),* 0988 BEQ 13$ MOVB #73,(R4)+ ; *,P 0998 CLR 12(SP) ; T+2 1002 MOV R0,10(SP) ; *,T 1003 MOV #2,R2 ; *,TEMP.STRING.P 1004 ADD SP,R2 ; TEMP.DIGITS,TEMP.STRING.P BIT $FMSK4,#F4.DVN ; 1005 BEQ 6$ MOV #12,(SP) ; *,BASE BR 7$ 6$: MOV #10,(SP) ; *,BASE 7$: CMP 10(SP),#77777 ; T,* 1007 BLOS 8$ MOVB #55,(R4)+ ; *,P 1009 NEG 10(SP) ; T 1010 8$: MOV #6,R3 ; *,I 1013 9$: MOV 10(SP),R1 ; T,* 1018 MOV 12(SP),R0 ; T,* DIV (SP),R0 ; BASE,* MOV R0,10(SP) ; *,T MOV R1,R5 ; *,CHAR MOV R5,R0 ; CHAR,* 1019 ADD #60,R0 MOVB R0,(R2)+ ; *,TEMP.STRING.P SOB R3,9$ ; I,* 1013 10$: CMPB -(R2),#60 ; TEMP.STRING.P,* 1029 BEQ 10$ ; 1030 MOV #2,R0 ; 1036 ADD SP,R0 ; TEMP.DIGITS,* BR 12$ 11$: MOVB (R2),(R4)+ ; I,P 1038 DEC R2 ; I 1036 12$: CMP R2,R0 ; I,* BGE 11$ 13$: MOV R4,R3 ; P,* 0873 ADD #14,SP MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R2 MOV (SP)+,R1 RTS PC ; Routine Size: 130 words, Routine Base: $CODE$ + 0420 ; Maximum stack depth per invocation: 14 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 1042 2 ! ; 1043 2 ! Do the parse ; 1044 2 ! ; 1045 2 ! FCS handles directory defaulting. This directive should not. ; 1046 2 ! ; 1047 2 do_directory_defaulting = false; ; 1048 2 must_have_device = false; ! Don't need explicit device for $PFCS ; 1049 2 cannot_have_node = true; ! FCS don't like them nodes ; 1050 2 common_parse (.dpb_ptr, .header_addr, .tcb_addr, fcs_convert); ; 1051 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL $LNFCS FCS Format Parse Directive .NLIST .ENABL LSB .LIST $LNFCS::CLR DO.DIRECTORY.DEFAULTING ; 1047 CLR MUST.HAVE.DEVICE ; 1048 MOV #1,CANNOT.HAVE.NODE ; 1049 MOV #FCS.CONVERT,R0 ; 1050 JSR PC,COMMON.PARSE RTS PC ; 0816 ; Routine Size: 12 words, Routine Base: $CODE$ + 1024 ; Maximum stack depth per invocation: 1 word .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 1052 1 %SBTTL 'Common Parse Code' ; 1053 1 ; 1054 1 ROUTINE common_parse (dpb_ptr, header_addr, tcb_addr, sec_spec_convert) : ; 1055 1 common_parse_l NOVALUE = ; 1056 1 ; 1057 1 !++ ; 1058 1 ! ; 1059 1 ! FUNCTIONAL DESCRIPTION: ; 1060 1 ! ; 1061 1 ! This routine is called by $LNRMS, $LNFCS, and $LNCHN to do the ; 1062 1 ! parse operation. See those routines for information on the parse ; 1063 1 ! operation. ; 1064 1 ! ; 1065 1 !-- ; 1066 2 BEGIN ; 1067 2 MAP ; 1068 2 dpb_ptr : REF VECTOR; ! Treat the DPB as a vector ; 1069 2 ; 1070 2 BIND ; 1071 2 dpb_ptr_b = dpb_ptr : REF VECTOR [, BYTE]; ! Treat the DPB as a vector of bytes ; 1072 2 ; 1073 2 LOCAL ; 1074 2 status, ; 1075 2 b_len, ! Buffer length ; 1076 2 b_addr, ! Buffer address ; 1077 2 b_mapping, ! Buffer mapping ; 1078 2 pri_logical_type, ! Saved primary logical type ; 1079 2 flags_for_user, ! Flags word to be returned ; 1080 2 do_assign_lun, ! Assign flag ; 1081 2 res_length, ! Resultant string length ; 1082 2 assign_lun_error, ! Deferred error from LUN assignment ; 1083 2 ucb, ! Address of the UCB for LUN ; 1084 2 merge_directory_flag, ! Merge hierarchial directories ; 1085 2 p : REF VECTOR; ! Temporary pointer ; 1086 2 ; 1087 2 LABEL ; 1088 2 process_file_specs, ; 1089 2 assign_lun, ; 1090 2 merge_directories; ; 1091 2 ; 1092 2 process_file_specs : ; 1093 3 BEGIN ; 1094 3 ! ; 1095 3 ! Initialize the logical descriptor block for later logical name ; 1096 3 ! translations. The length and offset address will be filled in later. ; 1097 3 ! ; 1098 3 init_logical_descriptor [block_type] = 0; ; 1099 3 init_logical_descriptor [table_number] = .dpb_ptr_b [1]; ! aka mod ; 1100 3 init_logical_descriptor [address_base] = .KISAR5; ! Logical names will be in the directive common ; 1101 3 init_logical_descriptor [matching_tcb_ucb] = .tcb_addr; ! For user table searches ; 1102 3 saved_inhibit_mask = .dpb_ptr_b [3]; ! Settup the inhibit mask ; 1103 3 ; 1104 3 do_assign_lun = true; ! Init to enable LUN assignment ; 1105 3 assign_lun_error = 0; ! LUN assignment ok ; 1106 3 merged = work_1 [0]; ! Initialize merged ; 1107 3 primary = work_2 [0]; ! Initialize secondary ; 1108 3 save_parse (scr_pb); ! Init the scratch parse block ; 1109 3 save_parse (pri_pb); ! Init the primary parse block ; 1110 3 ! ; 1111 3 ! Settup the users primary string. ; 1112 3 ! ; 1113 3 b_addr = .dpb_ptr [2]; ! Get primary string address ; 1114 3 b_len = .dpb_ptr [3]; ! Get string length ; 1115 3 ; 1116 3 IF .b_len NEQU 0 ; 1117 3 THEN ; 1118 4 BEGIN ; 1119 4 ; 1120 4 LOCAL ; 1121 4 trailing_length; ! Returned length from fss ; 1122 4 ; 1123 4 IF .b_addr EQLU 0 THEN ERROR_EXIT (IE_ADP); ; 1124 4 ; 1125 4 IF .b_len GTRU file_spec_size THEN ERROR_EXIT (IE_IBS); ; 1126 4 ; 1127 4 ! ; 1128 4 ! Address check, relocate, map, copy, compress, upcase, parse ; 1129 4 ! and expand the primary string. ; 1130 4 ! ; 1131 4 IF $ACHRO (.b_addr, .b_len) THEN ERROR_EXIT (IE_ADP); ! Check for read access ; 1132 4 ; 1133 4 b_addr = $RELOM (.b_addr); ! Map user buffer ; 1134 4 ; 1135 4 primary [0] = %C' '; ! Init it in case string is null ; 1136 4 ch$copy (.b_len, .b_addr, primary [0]; b_addr); ; 1137 4 fss (primary [0], .b_addr - primary [0];, trailing_length); ; 1138 4 IF .trailing_length NEQU 0 ; 1139 4 THEN ; 1140 5 BEGIN ; 1141 5 save_parse (pri_pb); ! Move scr_pb to primary ; 1142 5 pri_pb [fss_status] = bad_char; ! Settup the error code ; 1143 5 LEAVE process_file_specs; ! And return it ; 1144 4 END; ; 1145 4 ; 1146 4 END ; 1147 3 ELSE ; 1148 4 BEGIN ; 1149 4 primary [0] = %C' '; ! No filespec ; 1150 4 fss (primary [0], 1); ! Parse file specification ; 1151 3 END; ; 1152 3 ; 1153 3 save_parse (pri_pb); ! Move scr_pb to primary ; 1154 3 ; 1155 3 pri_logical_type = .pri_pb [logical_type]; ! Save the logical type for merge ; 1156 3 ; 1157 3 IF expand_filespec (.dpb_ptr) NEQU success THEN LEAVE process_file_specs; ! Expand any logicals ; 1158 3 ; 1159 3 IF .pri_pb [logical_type] GTRU .pri_logical_type ; 1160 3 THEN pri_logical_type = .pri_pb [logical_type]; ! Save the logical type for merge ; 1161 3 ; 1162 3 ! ; 1163 3 ! Settup the users secondary string. ; 1164 3 ! ; 1165 3 ! First validate the users buffer. Then call the appropriate routine ; 1166 3 ! to perform the conversion. ; 1167 3 ! ; 1168 3 b_addr = .dpb_ptr [9]; ! Get secondary string address ; 1169 3 b_len = .dpb_ptr [10]; ! Get string length ; 1170 3 ; 1171 3 IF .b_len NEQU 0 ; 1172 3 THEN ; 1173 4 BEGIN ; 1174 4 ; 1175 4 LOCAL ; 1176 4 trailing_length; ! Returned length from fss ; 1177 4 ; 1178 4 IF .b_addr EQLU 0 THEN ERROR_EXIT (IE_ADP); ; 1179 4 ; 1180 4 ! ; 1181 4 ! Address check, relocate, map, copy, compress, upcase, and parse ; 1182 4 ! the secondary string. ; 1183 4 ! ; 1184 4 ; 1185 4 IF $ACHRO (.b_addr, .b_len) THEN ERROR_EXIT (IE_ADP); ! Check for read access ; 1186 4 ; 1187 4 b_addr = $RELOM (.b_addr); ! Map user buffer ; 1188 4 ; 1189 4 sec_spec_convert_l (.sec_spec_convert, .b_addr, .b_len; b_addr); ; 1190 4 fss (secondary [0], .b_addr - secondary [0];, trailing_length); ; 1191 4 IF .trailing_length NEQU 0 ; 1192 4 THEN ; 1193 5 BEGIN ; 1194 5 ; 1195 5 ! ; 1196 5 ! Settup the bad string for return. ; 1197 5 ! ; 1198 5 primary = secondary [0]; ! The primary string is returned ; 1199 5 save_parse (pri_pb); ! Move scr_pb to primary ; 1200 5 pri_pb [fss_status] = bad_char; ! Settup the error code ; 1201 5 LEAVE process_file_specs; ! And return it ; 1202 4 END; ; 1203 4 ; 1204 4 END ; 1205 3 ELSE ; 1206 4 BEGIN ; 1207 4 secondary [0] = %C' '; ! No filespec ; 1208 4 fss (secondary [0], 1); ! Parse file specification ; 1209 3 END; ; 1210 3 ! ; 1211 3 ! If the primary string either before or after expansion contained ; 1212 3 ! a node or device then don't merge in a node or device from the ; 1213 3 ! secondary string. ; 1214 3 ! ; 1215 3 IF .pri_logical_type GTRU logical_type_filename ; 1216 3 THEN ; 1217 3 IF .scr_pb [logical_type] GTRU logical_type_filename !PKW156 ; 1218 3 THEN !PKW156 ; 1219 4 BEGIN ; 1220 4 scr_pb [flags] = .scr_pb [flags] AND NOT (FS$DEV OR FS$NOD); !JCF400 ; 1221 4 scr_pb [node_len] = 0; ; 1222 4 scr_pb [node_addr] = 0; ; 1223 4 scr_pb [device_len] = 0; ; 1224 4 scr_pb [device_addr] = 0; ; 1225 4 scr_pb [logical_type] = 0; !PKW156 ; 1226 3 END; ; 1227 3 ; 1228 3 ! ; 1229 3 ! Merge the users primary and secondary strings. Expand the result ; 1230 3 ! if a new logical could be present from the secondary string. ; 1231 3 ! ; 1232 3 IF merge () NEQU success THEN LEAVE process_file_specs; ; 1233 3 ; 1234 3 IF .pri_pb [logical_type] GTRU .pri_logical_type ; 1235 3 THEN ; 1236 3 ; 1237 3 IF expand_filespec (.dpb_ptr) NEQU success THEN LEAVE process_file_specs; ; 1238 3 ; 1239 3 flags_for_user = .pri_pb [flags]; ! Save flags to be returned ; 1240 3 ; 1241 3 ! ; 1242 3 ! If there is a node spec we are all done here. Return the parse ; 1243 3 ! block and string to the user. ; 1244 3 ! ; 1245 3 IF .pri_pb [node_addr] NEQU 0 THEN LEAVE process_file_specs; ; 1246 3 ! ; 1247 3 ! If the user did not provide a device apply the appropriate ; 1248 3 ! defaults. ; 1249 3 ! ; 1250 3 IF .pri_pb [device_addr] EQLU 0 ; 1251 3 THEN ; 1252 4 BEGIN ; 1253 4 ! ; 1254 4 ! The assign channel directive will not allow device ; 1255 4 ! defaulting. The device must be explicitly present. ; 1256 4 ! ; 1257 4 IF .must_have_device THEN ERROR_EXIT (IE_IDU); ; 1258 4 IF (.dpb_ptr [11] AND (FS$NDF OR FS$DEV)) EQLU 0 !Do we want to do defaults? ; 1259 4 THEN ; 1260 5 BEGIN ; 1261 5 ; 1262 5 KISAR6 = .$SAHDB; ! Make sure task header is mapped ; 1263 5 IF NOT $MPLUN (dpb_ptr_b [2], .header_addr, .tcb_addr; ucb) ; 1264 5 THEN ; 1265 6 BEGIN ; 1266 6 ! ; 1267 6 ! The device name will be merged in later. ; 1268 6 ! ; 1269 6 do_assign_lun = false; ! Don't reassign the LUN ; 1270 6 END ; 1271 5 ELSE ; 1272 6 BEGIN ; 1273 6 ! ; 1274 6 ! The LUN is not assigned, use the string SY: for the default. ; 1275 6 ! Put the default string in the secondary string and parse it ; 1276 6 ! in order to settup the scratch parse block. Next merge the ; 1277 6 ! default string with the primary string. Next expand any ; 1278 6 ! logical names that may have been introduced. ; 1279 6 ! ; 1280 6 MACRO ; 1281 6 ; 1282 6 ! ; 1283 6 ! Insert a character into a string. Increment the pointer. ; 1284 6 ! ; M 1285 6 ch$insert (value) = ; M 1286 6 BEGIN ; M 1287 6 dev_ptr [0] = value; ; M 1288 6 dev_ptr = dev_ptr [1]; ; M 1289 6 END ; 1290 6 %; ; 1291 6 ; 1292 6 REGISTER ; 1293 6 dev_ptr : REF VECTOR [, BYTE]; ! Pointer into the dev string ; 1294 6 ; 1295 6 dev_ptr = secondary [0]; ! Init the pointer ; 1296 6 ch$insert (%C'S'); ; 1297 6 ch$insert (%C'Y'); ; 1298 6 ch$insert (%C':'); ; 1299 6 fss (secondary [0], 3); ; 1300 6 IF merge () NEQU success THEN LEAVE process_file_specs; ; 1301 6 IF expand_filespec (.dpb_ptr) NEQU success THEN LEAVE process_file_specs; ; 1302 6 ! ; 1303 6 ! If there is a node spec we are all done here. Return the parse ; 1304 6 ! block and string to the user. ; 1305 6 ! ; 1306 6 IF .pri_pb [node_addr] NEQU 0 THEN LEAVE process_file_specs; ; 1307 5 END; ; 1308 4 END; ; 1309 3 END; ; 1310 3 ! ; 1311 3 ! Assign the LUN if appropriate. The LUN will not be assigned if ; 1312 3 ! the current LUN assignment is being used as the device default. ; 1313 3 ! ; 1314 3 assign_lun : ; 1315 4 BEGIN ; 1316 4 ; 1317 5 IF .do_assign_lun AND ((.dpb_ptr [11] AND (FS$NDF OR FS$DEV)) EQLU 0) ; 1318 4 THEN ; 1319 5 BEGIN ; 1320 5 MACRO ; 1321 5 ; 1322 5 ! ; 1323 5 ! NEXT_CHAR sets the next character and returns true if success ; 1324 5 ! ; M 1325 5 next_char = ; M 1326 5 BEGIN ; M 1327 5 char = .(.unit_ptr)<0, 8>; ; M 1328 5 unit_ptr = .unit_ptr + 1; ; M 1329 5 .char NEQU %C':' ; 1330 5 END %; ; 1331 5 ; 1332 5 ROUTINE ; 1333 5 ie_idu_return : return_ie_xxx_l = ERROR_EXIT (IE_IDU), ! Routine for assign_lun_error .NLIST .LIST BIN,LOC .LIST .SBTTL IE.IDU.RETURN Common Parse Code .NLIST .ENABL LSB .LIST IE.IDU.RETURN: MOV R0,-(SP) ; 1333 TRAP 244 MOV (SP)+,R0 RTS PC ; Routine Size: 4 words, Routine Base: $CODE$ + 1054 ; Maximum stack depth per invocation: 3 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 1334 5 ie_ilu_return : return_ie_xxx_l = ERROR_EXIT (IE_ILU); ! Routine for assign_lun_error .NLIST .LIST BIN,LOC .LIST .SBTTL IE.ILU.RETURN Common Parse Code .NLIST .ENABL LSB .LIST IE.ILU.RETURN: MOV R0,-(SP) ; 1334 TRAP 240 MOV (SP)+,R0 RTS PC ; Routine Size: 4 words, Routine Base: $CODE$ + 1064 ; Maximum stack depth per invocation: 3 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 1335 5 ; 1336 5 LOCAL ; 1337 5 unit_number, ! Unit number for device to be assigned to ; 1338 5 unit_ptr, ! Pointer into the unit number string ; 1339 5 char; ! Current character in unit number ; 1340 5 ; 1341 5 ! ; 1342 5 ! Check the length. It must be at least 3. ; 1343 5 ! ; 1344 5 IF .pri_pb [device_len] LSSU 3 ; 1345 5 THEN ; 1346 6 BEGIN ; 1347 6 assign_lun_error = ie_idu_return; ! The error will be reported ; 1348 6 LEAVE assign_lun; ! at the end ; 1349 5 END; ; 1350 5 ! ; 1351 5 ! Calculate the unit number ; 1352 5 ! ; 1353 5 unit_number = 0; ! Init the unit number ; 1354 5 unit_ptr = .pri_pb [device_addr] + 2; ! Init the pointer ; 1355 5 ; 1356 5 ! ; 1357 5 ! Loop thru the digits. ; 1358 5 ! ; 1359 5 WHILE next_char DO ; 1360 6 BEGIN ; 1361 6 ; 1362 6 ! ; 1363 6 ! Check the character. It must be an octal digit. ; 1364 6 ! ; 1365 7 IF (.char LSSU %C'0') OR (.char GTRU %C'7') ; 1366 6 THEN ; 1367 7 BEGIN ; 1368 7 assign_lun_error = ie_idu_return; ! The error will be reported ; 1369 7 LEAVE assign_lun; ! at the end ; 1370 6 END; ; 1371 6 ; 1372 6 unit_number = .unit_number * 8 + (.char - %C'0'); ! Add this one ; 1373 5 END; ; 1374 5 ; 1375 5 ! ; 1376 5 ! Give the LUN assignment routine the LUN number, the header address, ; 1377 5 ! the TCB address, the two letters of the device name, ; 1378 5 ! the unit number, and the terminal logical flag. ; 1379 5 ! ; 1380 5 ! The routine will assign the LUN if possible and return the directive ; 1381 5 ! error code if any. Any error will be signaled later, after as much ; 1382 5 ! information as possible has been returned to the user. ; 1383 5 ! ; 1384 5 ! If the terminal logical flag was set by the last expand then ; 1385 5 ! lun_assign will just look for the device in the system tables. ; 1386 5 ! If the logical was not terminal then the device translation that ; 1387 5 ! is normally done for the assign LUN directive will be done. ; 1388 5 ! ; 1389 5 KISAR6 = .$SAHDB; ! Make sure task header is mapped ; 1390 5 assign_lun_error = ; 1391 6 (IF .dpb_ptr_b [2] NEQU 0 ! Defer error for LUN of zero ; 1392 6 THEN ; 1393 6 lun_assign ( dpb_ptr_b [2], ; 1394 6 .header_addr, ; 1395 6 .tcb_addr, ; 1396 6 ..pri_pb [device_addr], ; 1397 6 .unit_number, ; 1398 6 .terminal_logical_flag; ; 1399 6 ucb) ; 1400 6 ELSE ; 1401 5 ie_ilu_return); ; 1402 4 END; ; 1403 3 END; ! assign_lun ; 1404 3 ! ; 1405 3 ! At this point the LUN is assigned. Either we are using the current ; 1406 3 ! assignment as the device default or the LUN was assigned above. ; 1407 3 ! ; 1408 3 ! The only exception is if the assign LUN failed. ; 1409 3 ! ; 1410 3 ! Here we will generate a device name and unit number and merge ; 1411 3 ! it into the primary string. First we will call $MPLND to track ; 1412 3 ! down an redirections. No point in doing any of this for ACHN because ; 1413 3 ! we do not return a string. ; 1414 3 ! ; 1415 3 IF .must_have_device THEN LEAVE process_file_specs; ; 1416 5 IF (.assign_lun_error EQLU 0) AND ((.dpb_ptr [11] AND (FS$NDF OR FS$DEV)) ; 1417 3 EQLU 0) THEN ; 1418 4 BEGIN ; 1419 4 LOCAL ; 1420 4 dcb, ! Address of the DCB for LUN ; 1421 4 unit_number, ! Unit number for device on this LUN ; 1422 4 redirected_ucb; ! We need the real UCB and the redirected ; 1423 4 ! UCB for spooled devices ; 1424 4 ; 1425 4 REGISTER ; 1426 4 dev_ptr : REF VECTOR [, BYTE]; ! Pointer into the dev string ; 1427 4 ; 1428 4 MACRO ; 1429 4 ; 1430 4 ! ; 1431 4 ! Insert a character into a string. Increment the pointer. ; 1432 4 ! ; M 1433 4 ch$insert (value) = ; M 1434 4 BEGIN ; M 1435 4 dev_ptr [0] = value; ; M 1436 4 dev_ptr = dev_ptr [1]; ; M 1437 4 END ; 1438 4 %; ; 1439 4 ; 1440 4 dev_ptr = secondary [0]; ! Init the pointer ; 1441 4 ; 1442 4 ! ; 1443 4 ! Now get the correct UCB address. Follow any redirections, ; 1444 4 ! and get both UCBs for spooled devices. ; 1445 4 ! ; 1446 4 $MPLND (.ucb, .tcb_addr; redirected_ucb, ucb); ; 1447 4 ; 1448 4 ! ; 1449 4 ! While we have the ucb address a check will be made. If the ; 1450 4 ! device is unit record, sequential or single directory then ; 1451 4 ! directory defaulting will not be done because a directory ; 1452 4 ! is not required. ; 1453 4 ! ; 1454 4 IF (.(.redirected_ucb + U_CW1) AND (DV_REC OR DV_SDI OR DV_SQD)) NEQU 0 ; 1455 4 THEN ; 1456 4 do_directory_defaulting = false; ; 1457 4 ; 1458 4 dcb = .(.ucb + U_DCB); ! Get the DCB address ; 1459 4 ; 1460 4 ! ; 1461 4 ! Calculate the logical unit number ; 1462 4 ! ; 1463 5 unit_number = ((.ucb - .(.dcb + D_UCB)) / .(.dcb + D_UCBL)) ! Relative UCB addr / UCB length ; 1464 4 + .(.dcb + D_UNIT) <0,8>; ! Plus lowest unit on this DCB ; 1465 4 ; 1466 4 ch$insert (%C'_'); ! Terminal logical from the LUN ; 1467 4 ch$insert (.(.dcb + D_NAM)); ! Fill in the device name ; 1468 4 ch$insert (.(.dcb + D_NAM + 1)); ; 1469 4 ; 1470 4 ! ; 1471 4 ! Generate the ASCII device number from the unit number ; 1472 4 ! zero suppressed. ; 1473 4 ! ; 1474 4 DCBTA_BLI (.unit_number, .dev_ptr; dev_ptr); ; 1475 4 ; 1476 4 ! ; 1477 4 ! Insert the trailing : ; 1478 4 ! ; 1479 4 ch$insert (%C':'); ; 1480 4 ; 1481 4 ! ; 1482 4 ! Parse the device spec and merge it into the ; 1483 4 ! primary string. ; 1484 4 ! ; 1485 4 fss (secondary [0], .dev_ptr - secondary [0]); ; 1486 4 ; 1487 4 ! ; 1488 4 ! Kill the primary device info so that the new device string ; 1489 4 ! will be merged in. ; 1490 4 ! ; 1491 4 pri_pb [device_len] = 0; ; 1492 4 pri_pb [device_addr] = 0; ; 1493 4 IF merge () NEQU success THEN LEAVE process_file_specs; ; 1494 3 END; ; 1495 3 ! ; 1496 3 ! If the user did not provide a directory or if the directory ; 1497 3 ! was null apply the appropriate defaults unless the directory ; 1498 3 ! defaulting flag is set off for the FCS format parse. If the ; 1499 3 ! user provided a directory with a leading . or - then this ; 1500 3 ! directory will be merged in with the default. ; 1501 3 ! ; 1502 4 merge_directory_flag = ((.pri_pb [directory_len] GEQU 3) AND ; 1503 5 ((.(.pri_pb [directory_addr] + 1)<0,8> EQLU %C'.') OR ; 1504 3 (.(.pri_pb [directory_addr] + 1)<0,8> EQLU %C'-'))); ; 1505 3 ; 1506 3 IF .do_directory_defaulting AND ; 1507 3 ((.dpb_ptr [11] AND (FS$NDF OR FS$DIR)) EQLU 0) AND ; 1508 4 ((.pri_pb [directory_addr] EQLU 0) OR ; 1509 4 (.pri_pb [directory_len] EQLU 2) OR ; 1510 4 .merge_directory_flag) ; 1511 3 THEN ; 1512 4 BEGIN ; 1513 4 ; 1514 4 ! ; 1515 4 ! Try to get the default directory string. Put it into ; 1516 4 ! the secondary string. It will be returned terminated ; 1517 4 ! by a blank. Then parse it. ; 1518 4 ! ; 1519 4 FIELD ; 1520 4 dds_context_f = ; 1521 4 SET ; 1522 4 reference_count= [0, 0, 8, 0], ! Reference count ; 1523 4 dds_length = [0, 8, 8, 0], ! Length of the default string ; 1524 4 dds_uic = [1, 0, 16, 0], ! UIC for clock block propagation ; 1525 4 default_string = [2, 0, 16, 0] ! Start of default string ; 1526 4 TES; ; 1527 4 ; 1528 4 LITERAL ; 1529 4 dds_context_size = 2; ! Size of the fixed part of the ; 1530 4 ! DDS context block in words ; 1531 4 ; 1532 4 BIND ; 1533 4 dds_context = apr6_v : BLOCK [dds_context_size] ; 1534 4 FIELD (dds_context_f); ! Default directory context block address ; 1535 4 ; 1536 4 LOCAL ; 1537 4 trailing_length, ! Returned length from fss ; 1538 4 default_length, ; 1539 4 p : REF VECTOR [,BYTE]; ! Pointer into secondary string ; 1540 4 ; 1541 4 ! ; 1542 4 ! Map the default directory string context block. If there is a task ; 1543 4 ! context block use that one. If not, use the one hung off of the ; 1544 4 ! terminal if it is present. If there is neither then return a DDS ; 1545 4 ! of blank. ; 1546 4 ! ; 1547 7 IF (KISAR6 = ( IF (.(.tcb_addr + T_CTX) NEQU 0) ; 1548 6 THEN ; 1549 7 .(.tcb_addr + T_CTX) ; 1550 6 ELSE ; 1551 7 (IF (.(.(.tcb_addr + T_UCB) + U_CW1) AND DV_PSE) EQLU 0 ; 1552 7 THEN ; 1553 8 .(.(.tcb_addr + T_UCB) + U_CTX) ; 1554 7 ELSE ; 1555 7 0) ; 1556 6 ) ; 1557 4 ) NEQU 0 ; 1558 4 ; 1559 4 THEN ; 1560 5 BEGIN ; 1561 5 ; 1562 5 ! ; 1563 5 ! Here we have the context block mapped. Copy, compress, and upcase the default ; 1564 5 ! directory string. Checking of the string is done by fss. ; 1565 5 ! ; 1566 5 default_length = .dds_context [dds_length]; ; 1567 5 ch$copy (.default_length, dds_context [default_string], secondary [0]; p); ; 1568 5 END ; 1569 4 ELSE ; 1570 4 default_length = 0; ; 1571 4 ; 1572 4 ! ; 1573 4 ! Parse the default string. ; 1574 4 ! ; 1575 4 fss (secondary [0], .default_length;, trailing_length); ; 1576 4 IF .trailing_length NEQU 0 ; 1577 4 THEN ; 1578 5 BEGIN ; 1579 5 ; 1580 5 ! ; 1581 5 ! Settup the bad string for return. ; 1582 5 ! ; 1583 5 primary = secondary [0]; ! The primary string is returned ; 1584 5 save_parse (pri_pb); ! Move scr_pb to primary ; 1585 5 pri_pb [fss_status] = bad_char; ! Settup the error code ; 1586 5 LEAVE process_file_specs; ! And return it ; 1587 4 END; ; 1588 4 ! ; 1589 4 ! Is there a valid non null default string? ; 1590 4 ! ; 1591 4 IF (.scr_pb [directory_addr] EQLU 0) OR ; 1592 4 (.scr_pb [directory_len] EQLU 2) OR ; 1593 5 ((.scr_pb [flags] AND (FS$NAM OR FS$TYP OR FS$VER)) NEQU 0) ; 1594 4 THEN ; 1595 5 BEGIN ; 1596 5 ; 1597 5 ! ; 1598 5 ! Generate the UIC format string ; 1599 5 ! ; 1600 5 MACRO ; 1601 5 ; 1602 5 ! ; 1603 5 ! Insert a character into a string. Increment the pointer. ; 1604 5 ! ; M 1605 5 ch$insert (value) = ; M 1606 5 BEGIN ; M 1607 5 dir_ptr [0] = value; ; M 1608 5 dir_ptr = dir_ptr [1]; ; M 1609 5 END ; 1610 5 %; ; 1611 5 ; 1612 5 LOCAL ; 1613 5 dir_ptr : REF VECTOR [, BYTE]; ! Pointer into the dir string ; 1614 5 ; 1615 5 BIND ; 1616 5 uic_group = .header_addr + H_DUIC + 1 : BYTE, ! Default UIC ; 1617 5 uic_owner = .header_addr + H_DUIC : BYTE; ; 1618 5 ; 1619 5 KISAR6 = .$SAHDB; ! Make sure task header is mapped ; 1620 5 dir_ptr = secondary [0]; ! Init it ; 1621 5 ch$insert (%C'['); ! Put in the opening [ ; 1622 5 ; 1623 5 ! ; 1624 5 ! Fill in the group zero suppressed. Include the zero if it ; 1625 5 ! is the only character. ; 1626 5 ! ; 1627 5 IF .uic_group <6,2> NEQU 0 ; 1628 5 THEN ; 1629 6 BEGIN ; 1630 6 ch$insert (.uic_group <6,2> + %C'0'); ; 1631 6 ch$insert (.uic_group <3,3> + %C'0'); ; 1632 6 END ; 1633 5 ELSE ; 1634 5 IF .uic_group <3,3> NEQU 0 THEN ch$insert (.uic_group <3,3> + %C'0'); ; 1635 5 ch$insert (.uic_group <0,3> + %C'0'); ; 1636 5 ; 1637 5 ch$insert (%C','); ! Insert the comma. ; 1638 5 ; 1639 5 ! ; 1640 5 ! Fill in the group and owner zero suppressed. ; 1641 5 ! ; 1642 5 IF .uic_owner <6,2> NEQU 0 ; 1643 5 THEN ; 1644 6 BEGIN ; 1645 6 ch$insert (.uic_owner <6,2> + %C'0'); ; 1646 6 ch$insert (.uic_owner <3,3> + %C'0'); ; 1647 6 END ; 1648 5 ELSE ; 1649 5 IF .uic_owner <3,3> NEQU 0 THEN ch$insert (.uic_owner <3,3> + %C'0'); ; 1650 5 ch$insert (.uic_owner <0,3> + %C'0'); ; 1651 5 ; 1652 5 ! ; 1653 5 ! Finish up the directory string and parse it. ; 1654 5 ! ; 1655 5 ch$insert (%C']'); ! Put in the trailing ] ; 1656 5 ; 1657 5 ! ; 1658 5 ! Parse the default UIC format directory string. ; 1659 5 ! ; 1660 5 fss (secondary [0], .dir_ptr - secondary [0]); ; 1661 4 END; ! Create UIC format directory string ; 1662 4 ! ; 1663 4 ! If the user supplied directory string contains a leading ; 1664 4 ! . or - merge it with the default directory string. ; 1665 4 ! ; 1666 4 IF .merge_directory_flag ; 1667 4 THEN ; 1668 5 BEGIN ; 1669 5 status = ! Set the status from merge ; 1670 5 merge_directories : ; 1671 6 BEGIN ; 1672 6 ; 1673 6 LOCAL ; 1674 6 bracket : UNSIGNED BYTE, ; 1675 6 default_dir : REF VECTOR [, BYTE], ; 1676 6 user_dir : REF VECTOR [, BYTE]; ; 1677 6 ; 1678 6 ! ; 1679 6 ! The user directory pointer is initialized to point ; 1680 6 ! to the beginning of the directory string provided ; 1681 6 ! by the user. The default directory pointer is ; 1682 6 ! initialized to point to the end of the default ; 1683 6 ! directory string. ; 1684 6 ! ; 1685 6 user_dir = .pri_pb [directory_addr] + 1; ; 1686 6 default_dir = .scr_pb [trailing_addr] - 2; ; 1687 6 ; 1688 6 ! ; 1689 6 ! Save the trailing bracket from the default string. ; 1690 6 ! This will be used to close the merged directory ; 1691 6 ! string. ; 1692 6 ! ; 1693 6 bracket = .(.scr_pb [trailing_addr] - 1)<0,8>; ; 1694 6 ; 1695 6 ! ; 1696 6 ! Loop thru any '-' requests and backup in the ; 1697 6 ! default directory. ; 1698 6 ! ; 1699 6 WHILE .user_dir [0] EQLU %C'-' DO ; 1700 7 BEGIN ; 1701 7 user_dir = user_dir [1]; ; 1702 7 ; 1703 7 ! ; 1704 7 ! '.' is bad here ; 1705 7 ! ; 1706 7 IF .default_dir [0] EQLU %C'.' ; 1707 7 THEN ; 1708 7 LEAVE merge_directories WITH pri_pb [fss_status] = bad_directory; ; 1709 7 ! ; 1710 7 ! Backup one level in the default string if ; 1711 7 ! there is one. ; 1712 7 ! ; 1713 7 WHILE 1 DO ; 1714 8 BEGIN ; 1715 8 ; 1716 8 ! ; 1717 8 ! Check for no more default directory. ; 1718 8 ! ; 1719 8 IF default_dir [0] EQLA .scr_pb [directory_addr] ; 1720 8 THEN ; 1721 8 EXITLOOP; ; 1722 8 ; 1723 8 IF .default_dir [0] EQLU %C'.' ; 1724 8 THEN ; 1725 9 BEGIN ; 1726 9 default_dir = default_dir [-1]; ! Back over the '.' ; 1727 9 EXITLOOP; ! And exit ; 1728 9 END ; 1729 8 ELSE ; 1730 8 default_dir = default_dir [-1]; ! Backup a character ; 1731 8 ; 1732 7 END; ; 1733 6 END; ! End of hyphen loop ; 1734 6 ; 1735 6 ! ; 1736 6 ! '.' is bad here too ; 1737 6 ! ; 1738 6 IF .default_dir [0] EQLU %C'.' ; 1739 6 THEN ; 1740 6 LEAVE merge_directories WITH pri_pb [fss_status] = bad_directory; ; 1741 6 ; 1742 6 ! ; 1743 6 ! Check for remaining default directory string. ; 1744 6 ! ; 1745 6 IF default_dir [0] EQLA .scr_pb [directory_addr] ; 1746 6 THEN ; 1747 7 BEGIN ; 1748 7 ; 1749 7 ! ; 1750 7 ! Here we are out of default directory string. ; 1751 7 ! Eat a leading '.' in the users string unless ; 1752 7 ! it is part of '...'. '..' will also be accepted. ; 1753 7 ! That case will be caught in the access methods. ; 1754 7 ! ; 1755 7 IF .user_dir [0] EQLU %C'.' ; 1756 7 THEN ; 1757 8 BEGIN ; 1758 8 ; 1759 8 ! ; 1760 8 ! Skip the leading '.' ; 1761 8 ! ; 1762 8 user_dir = user_dir [1]; ; 1763 8 ; 1764 8 ! ; 1765 8 ! If the next character is a '.' also then backup ; 1766 8 ! to include the previous dot also. ; 1767 8 ! ; 1768 8 IF .user_dir [0] EQLU %C'.' ; 1769 8 THEN ; 1770 8 user_dir = user_dir [-1]; ; 1771 8 ; 1772 7 END; ! End of leading '.' in user directory ; 1773 7 ; 1774 7 ! ; 1775 7 ! If the users directory spec is gone too, we must setup ; 1776 7 ! the MFD as the directory spec. ; 1777 7 ! ; 1778 8 IF user_dir [0] EQLA (.pri_pb [directory_addr] + .pri_pb [directory_len] - 1) ; 1779 7 THEN ; 1780 8 BEGIN ; 1781 8 DECR i FROM 5 TO 0 DO ! Move the MFD name ; 1782 9 BEGIN ; 1783 9 default_dir = default_dir [1]; ! Advance the pointer ; 1784 9 default_dir [0] = %C'0'; ! Insert the character ; 1785 8 END; ; 1786 7 END; ; 1787 7 END ! End of out of default directory ; 1788 6 ELSE ; 1789 7 BEGIN ; 1790 7 ; 1791 7 ! ; 1792 7 ! Here we have some default directory string left. ; 1793 7 ! Make sure that the users directory spec has a ; 1794 7 ! leading '.' unless it is null. If it does not ; 1795 7 ! then append a '.' at the end of the default string. ; 1796 7 ! ; 1797 8 IF user_dir [0] NEQA (.pri_pb [directory_addr] + .pri_pb [directory_len] - 1) ; 1798 7 THEN ; 1799 7 IF .user_dir [0] NEQU %C'.' ; 1800 7 THEN ; 1801 8 BEGIN ; 1802 8 default_dir = default_dir [1]; ! Advance pointer ; 1803 8 default_dir [0] = %C'.'; ! Append the . ; 1804 7 END; ; 1805 7 ; 1806 6 END; ! End of default directory remaining ; 1807 6 ; 1808 6 ! ; 1809 6 ! Now merge the remaining user string with the remaining ; 1810 6 ! default directory string. ; 1811 6 ! ; 1812 6 WHILE user_dir [0] NEQA (.pri_pb [directory_addr] + .pri_pb [directory_len] - 1) DO ; 1813 7 BEGIN ; 1814 7 default_dir = default_dir [1]; ; 1815 7 default_dir [0] = .user_dir [0]; ; 1816 7 user_dir = user_dir [1]; ; 1817 6 END; ; 1818 6 ; 1819 6 ! ; 1820 6 ! Include the closing character and ; 1821 6 ! parse the new default string. ; 1822 6 ! ; 1823 6 default_dir = default_dir [1]; ; 1824 6 default_dir [0] = .bracket; ; 1825 6 fss (secondary [0], default_dir [0] - .scr_pb [directory_addr] + 1; ,trailing_length); ; 1826 6 ; 1827 6 ! ; 1828 6 ! Check the merged directory and return the status. ; 1829 6 ! ; 1830 6 LEAVE merge_directories WITH ; 1831 6 IF .trailing_length NEQU 0 ; 1832 6 THEN ; 1833 6 pri_pb [fss_status] = bad_directory ! Error code ; 1834 6 ELSE ; 1835 6 success; ! Return the status ; 1836 6 ; 1837 5 END; ! merge_directories ; 1838 5 ; 1839 5 ! ; 1840 5 ! Check the status and return any errors to the user. ; 1841 5 ! ; 1842 5 IF .status NEQU success ; 1843 5 THEN ; 1844 6 BEGIN ; 1845 6 ; 1846 6 ! ; 1847 6 ! Settup the bad string for return. ; 1848 6 ! ; 1849 6 primary = secondary [0]; ! The primary string is returned ; 1850 6 save_parse (pri_pb); ! Move scr_pb to primary ; 1851 6 pri_pb [fss_status] = .status; ! Settup the error code ; 1852 6 LEAVE process_file_specs; ! And return it ; 1853 5 END; ; 1854 4 END; ! IF .merge_directory_flag ; 1855 4 ! ; 1856 4 ! Merge the default directory into the primary string. ; 1857 4 ! First zero the length and address for the directory in ; 1858 4 ! the primary string in case it was null. ; 1859 4 ! ; 1860 4 pri_pb [directory_len] = 0; ; 1861 4 pri_pb [directory_addr] = 0; ; 1862 4 merge(); ; 1863 3 END; ! Add default directory ; 1864 3 ! ; 1865 3 ! Remove any portions of the resultant string that the user ; 1866 3 ! doesn't want. This functionality is used by RMS-11 if some ; 1867 3 ! portion of the file spec is provided in the NAM Block. ; 1868 3 ! ; 1869 4 BEGIN ; 1870 4 ; 1871 4 LOCAL ; 1872 4 do_merge; ; 1873 4 ; 1874 4 secondary [0] = %C' '; ! Set up secondary with a blank ; 1875 4 do_merge = false; ; 1876 4 IF (.dpb_ptr [11] AND FS$NOD) NEQU 0 ; 1877 4 THEN ; 1878 5 BEGIN ; 1879 5 pri_pb [node_addr] = 0; ; 1880 5 pri_pb [node_len] = 0; ; 1881 5 do_merge = true; ; 1882 4 END; ; 1883 4 IF (.dpb_ptr [11] AND FS$DEV) NEQU 0 ; 1884 4 THEN ; 1885 5 BEGIN ; 1886 5 pri_pb [device_addr] = 0; ; 1887 5 pri_pb [device_len] = 0; ; 1888 5 do_merge = true; ; 1889 4 END; ; 1890 4 ; 1891 4 ! Neither FCS nor RMS likes the underscore returned on the device. ; 1892 4 ! If it's there, strip it off. ; 1893 4 ! ; 1894 4 IF .(.pri_pb [device_addr])<0,8> EQLU %C'_' ; 1895 4 THEN ; 1896 5 BEGIN ; 1897 5 pri_pb [device_addr] = .pri_pb [device_addr] + 1; ; 1898 5 pri_pb [device_len] = .pri_pb [device_len] - 1; ; 1899 5 do_merge = true; ; 1900 4 END; ; 1901 4 ; 1902 4 IF (.dpb_ptr [11] AND FS$DIR) NEQU 0 ; 1903 4 THEN ; 1904 5 BEGIN ; 1905 5 pri_pb [directory_addr] = 0; ; 1906 5 pri_pb [directory_len] = 0; ; 1907 5 do_merge = true; ; 1908 4 END; ; 1909 4 IF (.dpb_ptr [11] AND FS$NAM) NEQU 0 ; 1910 4 THEN ; 1911 5 BEGIN ; 1912 5 pri_pb [filename_addr] = 0; ; 1913 5 pri_pb [filename_len] = 0; ; 1914 5 do_merge = true; ; 1915 4 END; ; 1916 4 ! ; 1917 4 ! Include a . in the primary string if the primary string ; 1918 4 ! does not have a type in it, we are doing defaults, and ; 1919 4 ! directory defaulting is enabled. ; 1920 4 ! ; 1921 4 IF (.dpb_ptr [11] AND FS$TYP) NEQU 0 ; 1922 4 THEN ; 1923 5 BEGIN ; 1924 5 pri_pb [type_addr] = 0; ; 1925 5 pri_pb [type_len] = 0; ; 1926 5 do_merge = true; ; 1927 5 END ; 1928 4 ELSE ; 1929 4 IF .do_directory_defaulting AND (.dpb_ptr [11] AND FS$NDF) EQLU 0 ; 1930 4 THEN ; 1931 5 BEGIN ; 1932 5 secondary [0] = %C'.'; ! Include the "." for RMS ; 1933 5 do_merge = true; ; 1934 4 END; ; 1935 4 ; 1936 4 IF (.dpb_ptr [11] AND FS$VER) NEQU 0 ; 1937 4 THEN ; 1938 5 BEGIN ; 1939 5 pri_pb [version_addr] = 0; ; 1940 5 pri_pb [version_len] = 0; ; 1941 5 do_merge = true; ; 1942 4 END; ; 1943 4 IF .do_merge THEN ; 1944 5 BEGIN ; 1945 5 fss (secondary [0], 1); ! Parse file specification ; 1946 5 merge (); ! And do the merge ; 1947 4 END; ; 1948 3 END; ; 1949 2 END; ! process_file_specs ; 1950 2 ! ; 1951 2 ! Return the expanded string and the primary parse block ; 1952 2 ! with the saved flags to the user. ; 1953 2 ! ; 1954 2 ! ; 1955 2 ! First return the strings length if the buffer is provided. ; 1956 2 ! Don't do any of this for ACHN, because we don't return a string. ; 1957 2 ; 1958 2 IF NOT .must_have_device ; 1959 2 THEN ; 1960 3 BEGIN ; 1961 3 b_addr = .dpb_ptr [6]; ! Get resultant length address ; 1962 3 IF .pri_pb [trailing_addr] NEQU 0 ! Get the length ; 1963 3 THEN ; 1964 3 res_length = .pri_pb [trailing_addr] - primary [0] + .pri_pb [trailing_len] ; 1965 3 ELSE ; 1966 3 res_length = 0; ; 1967 3 ; 1968 3 IF .b_addr NEQU 0 ; 1969 3 THEN ; 1970 4 BEGIN ; 1971 4 IF $ACHKB (.b_addr, 2) THEN ERROR_EXIT (IE_ADP); ! Check for read/write access ; 1972 4 p = $RELOM (.b_addr); ! Map user buffer ; 1973 4 .p = .res_length; ! Fill in the length ; 1974 3 END; ; 1975 3 ; 1976 3 ! ; 1977 3 ! RMS requires that the version number delimiter be a ; and not a ; 1978 3 ! . in the resultant string. It uses this for some later parsing. ; 1979 3 ! ; 1980 3 IF .pri_pb [version_len] NEQU 0 THEN (.pri_pb [version_addr])<0,8> = %C';'; ; 1981 3 ; 1982 3 ! ; 1983 3 ! Then return as much of the string as possible, ; 1984 3 ! ; 1985 3 b_addr = .dpb_ptr [4]; ! Get resultant address ; 1986 3 b_len = .dpb_ptr [5]; ! Get resultant length ; 1987 3 $RELOC (.b_addr; b_mapping, p); ! Relocte user buffer ; 1988 3 convert_parse (pri_pb, primary [0], .b_addr); ! Convert parse block addresses to user mode ; 1989 3 ; 1990 3 IF .b_len NEQU 0 ; 1991 3 THEN ; 1992 4 BEGIN ; 1993 4 ; 1994 4 IF .b_addr EQLU 0 THEN ERROR_EXIT (IE_ADP); ; 1995 4 ; 1996 4 ! ; 1997 4 ! Address check the user buffer. Then copy the ; 1998 4 ! resultant string into it. ; 1999 4 ! ; 2000 4 IF $ACHKB (.b_addr, .b_len) THEN ERROR_EXIT (IE_ADP); ! Check for read/write access ; 2001 4 ; 2002 4 IF .res_length NEQU 0 THEN $BLXIO (MINU (.res_length, .b_len), .kisar5, primary [0], .b_mapping, .p); ; 2003 4 ; 2004 4 ! Move it ; 2005 3 END; ; 2006 3 ! ; 2007 3 ! Now return as much of the parse block as possible, ; 2008 3 ! ; 2009 3 pri_pb [flags] = .flags_for_user; ! Save flags to be returned ; 2010 4 IF .cannot_have_node AND (.pri_pb [node_addr] NEQU 0) ! If a node is illegal, put status in parse block ; 2011 3 THEN pri_pb [fss_status] = bad_logical; ; 2012 3 b_addr = .dpb_ptr [7]; ! Get parse block address ; 2013 3 b_len = .dpb_ptr [8]; ! Get parse block length ; 2014 3 ; 2015 3 IF .b_len NEQU 0 ; 2016 3 THEN ; 2017 4 BEGIN ; 2018 4 ; 2019 4 IF .b_addr EQLU 0 THEN ERROR_EXIT (IE_ADP); ; 2020 4 ; 2021 4 ! ; 2022 4 ! Address check and relocate the user buffer. Then copy the ; 2023 4 ! parse block into it. ; 2024 4 ! ; 2025 4 IF $ACHKB (.b_addr, .b_len) THEN ERROR_EXIT (IE_ADP); ! Check for read/write access ; 2026 4 ; 2027 4 $RELOC (.b_addr; b_mapping, b_addr); ! Relocte user buffer ; 2028 4 $BLXIO (MINU (parse_block_size*2, .b_len), .kisar5, pri_pb, .b_mapping, .b_addr); ! Move it ; 2029 3 END; ; 2030 2 END; ; 2031 2 ! ; 2032 2 ! The LUN assignment may have returned an error. If it did the signaling ; 2033 2 ! of that error was deferred so that more information about the error ; 2034 2 ! could be returned to the user. ; 2035 2 ! ; 2036 2 ! If there was an error signal it now. ; 2037 2 ! ; 2038 2 IF .assign_lun_error NEQU 0 THEN return_ie_xxx_l (.assign_lun_error); ; 2039 2 IF .pri_pb [fss_status] NEQU success THEN ERROR_EXIT (IE_LNF); ; 2040 2 ; 2041 2 RETURN; ; 2042 1 END; .NLIST .LIST BIN,LOC .LIST DDS.CONTEXT= -40000 .SBTTL COMMON.PARSE Common Parse Code .NLIST .ENABL LSB .LIST COMMON.PARSE: JSR R1,$SAVE5 ; 1054 SUB #24,SP MOV R0,20(SP) MOV R5,12(SP) MOV R4,10(SP) MOV R3,14(SP) CLRB INIT.LOGICAL.DESCRIPTOR+7 ; 1098 MOV R3,R0 ; 1099 MOVB 1(R0),INIT.LOGICAL.DESCRIPTOR+6 MOV KISAR5,INIT.LOGICAL.DESCRIPTOR+2; 1100 MOV R5,INIT.LOGICAL.DESCRIPTOR+10 ; 1101 MOVB 3(R0),SAVED.INHIBIT.MASK ; 1102 CLRB SAVED.INHIBIT.MASK+1 MOV #1,16(SP) ; *,DO.ASSIGN.LUN 1104 CLR 6(SP) ; ASSIGN.LUN.ERRO 1105 MOV #WORK.1,MERGED ; 1106 MOV #WORK.2,PRIMARY ; 1107 MOV #SCR.PB,R1 ; 1108 JSR PC,SAVE.PARSE MOV #PRI.PB,R1 ; 1109 JSR PC,SAVE.PARSE MOV 14(SP),R0 ; 1113 MOV 4(R0),4(SP) ; *,B.ADDR MOV 6(R0),2(SP) ; *,B.LEN 1114 BEQ 4$ ; 1116 TST 4(SP) ; B.ADDR 1123 BNE 1$ TRAP 236 1$: CMP 2(SP),#377 ; B.LEN,* 1125 BLOS 2$ TRAP 247 2$: MOV 4(SP),R0 ; B.ADDR,* 1131 MOV 2(SP),R1 ; B.LEN,* JSR PC,$ACHRO BHIS 3$ TRAP 236 3$: MOV 4(SP),R0 ; B.ADDR,* 1133 JSR PC,$RELOM MOV R0,4(SP) ; *,B.ADDR MOVB #40,@PRIMARY ; 1135 MOV 2(SP),R1 ; B.LEN,* 1136 MOV R0,R2 ; B.ADDR,* MOV PRIMARY,R3 JSR PC,CH$COPY MOV R3,4(SP) MOV R3,R0 ; B.ADDR,* 1137 SUB PRIMARY,R0 MOV PRIMARY,R4 MOV R0,R5 JSR PC,FSS TST R5 ; TRAILING.LENGTH 1138 BEQ 5$ JMP 38$ ; 1141 4$: MOVB #40,@PRIMARY ; 1149 MOV PRIMARY,R4 ; 1150 MOV #1,R5 JSR PC,FSS 5$: MOV #PRI.PB,R1 ; 1153 JSR PC,SAVE.PARSE CLR 22(SP) ; PRI.LOGICAL.TYP 1155 MOVB PRI.PB+44,22(SP) ; *,PRI.LOGICAL.TYP MOV 14(SP),R3 ; 1157 JSR PC,EXPAND.FILESPEC CMP R0,#1 BNE 13$ CLR R0 ; 1159 BISB PRI.PB+44,R0 CMP R0,22(SP) ; *,PRI.LOGICAL.TYP BLOS 6$ CLR 22(SP) ; PRI.LOGICAL.TYP 1160 MOVB PRI.PB+44,22(SP) ; *,PRI.LOGICAL.TYP 6$: MOV 14(SP),R0 ; 1168 MOV 22(R0),4(SP) ; *,B.ADDR MOV 24(R0),2(SP) ; *,B.LEN 1169 BEQ 9$ ; 1171 TST 4(SP) ; B.ADDR 1178 BNE 7$ TRAP 236 7$: MOV 4(SP),R0 ; B.ADDR,* 1185 MOV 2(SP),R1 ; B.LEN,* JSR PC,$ACHRO BHIS 8$ TRAP 236 8$: MOV 4(SP),R0 ; B.ADDR,* 1187 JSR PC,$RELOM MOV R0,4(SP) ; *,B.ADDR MOV R0,R3 ; B.ADDR,* 1189 MOV 2(SP),R4 ; B.LEN,* JSR PC,@20(SP) MOV R3,4(SP) MOV R3,R0 ; B.ADDR,* 1190 SUB #SECONDARY,R0 MOV #SECONDARY,R4 MOV R0,R5 JSR PC,FSS TST R5 ; TRAILING.LENGTH 1191 BEQ 10$ JMP 37$ ; 1198 9$: MOVB #40,SECONDARY ; 1207 MOV #SECONDARY,R4 ; 1208 MOV #1,R5 JSR PC,FSS 10$: CMP 22(SP),#1 ; PRI.LOGICAL.TYP,* 1215 BLOS 11$ CMPB SCR.PB+44,#1 ; 1217 BLOS 11$ BIC #600,SCR.PB+2 ; 1220 CLR SCR.PB+4 ; 1221 CLR SCR.PB+6 ; 1222 CLR SCR.PB+10 ; 1223 CLR SCR.PB+12 ; 1224 CLRB SCR.PB+44 ; 1225 11$: JSR PC,MERGE ; 1232 CMP R0,#1 BNE 16$ CLR R0 ; 1234 BISB PRI.PB+44,R0 CMP R0,22(SP) ; *,PRI.LOGICAL.TYP BLOS 12$ MOV 14(SP),R3 ; 1237 JSR PC,EXPAND.FILESPEC CMP R0,#1 BNE 16$ 12$: MOV PRI.PB+2,22(SP) ; *,FLAGS.FOR.USER 1239 TST PRI.PB+6 ; 1245 13$: BNE 16$ TST PRI.PB+12 ; 1250 BNE 17$ BIT #1,MUST.HAVE.DEVICE ; 1257 BEQ 14$ TRAP 244 14$: MOV 14(SP),R0 ; 1258 BIT #10200,26(R0) BNE 17$ MOV $SAHDB,KISAR6 ; 1262 MOV R0,R3 ; 1263 ADD #2,R3 MOV 10(SP),R4 MOV 12(SP),R5 JSR PC,$MPLUN ROL (SP) MOV R2,20(SP) ROR (SP) BCS 15$ CLR 16(SP) ; DO.ASSIGN.LUN 1269 BR 17$ ; 1263 15$: MOV #SECONDARY,R0 ; *,DEV.PTR 1295 MOVB #123,(R0)+ ; *,DEV.PTR 1296 MOVB #131,(R0)+ ; *,DEV.PTR 1297 MOVB #72,(R0)+ ; *,DEV.PTR 1298 MOV #SECONDARY,R4 ; 1299 MOV #3,R5 JSR PC,FSS JSR PC,MERGE ; 1300 CMP R0,#1 BNE 16$ MOV 14(SP),R3 ; 1301 JSR PC,EXPAND.FILESPEC CMP R0,#1 BNE 16$ TST PRI.PB+6 ; 1306 16$: BEQ 17$ JMP 73$ 17$: BIT #1,16(SP) ; *,DO.ASSIGN.LUN 1317 BEQ 23$ MOV 14(SP),R0 BIT #10200,26(R0) BNE 23$ CMP PRI.PB+10,#3 ; 1344 BLO 19$ ; 1347 CLR R1 ; UNIT.NUMBER 1353 MOV PRI.PB+12,R2 ; *,UNIT.PTR 1354 ADD #2,R2 ; *,UNIT.PTR 18$: CLR R3 ; CHAR 1359 BISB (R2)+,R3 ; UNIT.PTR,CHAR CMP R3,#72 ; CHAR,* BEQ 21$ CMP R3,#60 ; CHAR,* 1365 BLO 19$ CMP R3,#67 ; CHAR,* BLOS 20$ 19$: MOV #IE.IDU.RETURN,6(SP) ; *,ASSIGN.LUN.ERRO 1368 BR 23$ ; 1367 20$: MOV R1,R0 ; UNIT.NUMBER,* 1372 ASH #3,R0 ADD R3,R0 ; CHAR,* MOV R0,R1 ; *,UNIT.NUMBER SUB #60,R1 ; *,UNIT.NUMBER BR 18$ ; 1359 21$: MOV $SAHDB,KISAR6 ; 1389 MOV #2,R0 ; 1391 ADD 14(SP),R0 MOV R0,R3 TSTB (R3) BEQ 22$ MOV 10(SP),R4 ; 1393 MOV 12(SP),R5 MOV @PRI.PB+12,R0 MOV TERMINAL.LOGICAL.FLAG,R2 JSR PC,LUN.ASSIGN MOV R0,6(SP) ; *,ASSIGN.LUN.ERRO MOV R1,20(SP) BR 23$ ; 1391 22$: MOV #IE.ILU.RETURN,6(SP) ; *,ASSIGN.LUN.ERRO 23$: BIT #1,MUST.HAVE.DEVICE ; 1415 BEQ 24$ JMP 89$ 24$: TST 6(SP) ; ASSIGN.LUN.ERRO 1416 BNE 26$ MOV 14(SP),R0 BIT #10200,26(R0) BNE 26$ MOV #SECONDARY,R3 ; *,DEV.PTR 1440 MOV 20(SP),R0 ; UCB,* 1446 MOV 12(SP),R5 JSR PC,$MPLND MOV R2,20(SP) MOV #DV.REC,R1 ; 1454 BIS #DV.SDI,R1 BIS #DV.SQD,R1 BIT U.CW1(R0),R1 ; *(REDIRECTED.UCB),* BEQ 25$ CLR DO.DIRECTORY.DEFAULTING ; 1456 25$: MOV 20(SP),R0 ; UCB,* 1458 MOV U.DCB(R0),R2 ; *(UCB),DCB SUB D.UCB(R2),R0 ; *(DCB),* 1463 MOV R0,R1 SXT R0 DIV D.UCBL(R2),R0 ; *(DCB),* CLR R1 ; 1464 BISB D.UNIT(R2),R1 ; *(DCB),* ADD R1,R0 MOVB #137,(R3)+ ; *,DEV.PTR 1466 MOVB D.NAM(R2),(R3)+ ; *(DCB),DEV.PTR 1467 MOVB D.NAM+1(R2),(R3)+ ; *(DCB),DEV.PTR 1468 JSR PC,DCBTA.BLI ; 1474 MOVB #72,(R3)+ ; *,DEV.PTR 1479 SUB #SECONDARY,R3 ; 1485 MOV #SECONDARY,R4 MOV R3,R5 JSR PC,FSS CLR PRI.PB+10 ; 1491 CLR PRI.PB+12 ; 1492 JSR PC,MERGE ; 1493 CMP R0,#1 BNE 39$ 26$: CLR R3 ; 1502 CMP PRI.PB+14,#3 BLO 27$ INC R3 27$: MOV PRI.PB+16,R0 ; 1503 CLR R2 CMPB 1(R0),#56 BNE 28$ INC R2 28$: CLR R1 ; 1504 CMPB 1(R0),#55 BNE 29$ INC R1 29$: BIS R2,R1 ; 1503 MOV R1,16(SP) ; *,MERGE.DIRECTORY 1502 MOV R3,R0 COM R0 BIC R0,16(SP) ; *,MERGE.DIRECTORY BIT #1,DO.DIRECTORY.DEFAULTING ; 1506 BEQ 30$ MOV 14(SP),R0 ; 1507 BIT #10100,26(R0) BEQ 31$ 30$: JMP 63$ 31$: TST PRI.PB+16 ; 1508 BEQ 32$ CMP PRI.PB+14,#2 ; 1509 BEQ 32$ BIT #1,16(SP) ; *,MERGE.DIRECTORY 1510 BEQ 30$ 32$: MOV 12(SP),R1 ; 1547 MOV T.CTX(R1),R0 BNE 34$ MOV T.UCB(R1),R0 ; 1551 BIT U.CW1(R0),#DV.PSE BNE 33$ MOV U.CTX(R0),R0 BR 34$ 33$: CLR R0 34$: MOV R0,KISAR6 ; 1547 BEQ 35$ ; 1557 CLR R5 ; DEFAULT.LENGTH 1566 BISB @#140001,R5 ; *,DEFAULT.LENGTH MOV R5,R1 ; DEFAULT.LENGTH,* 1567 MOV #-37774,R2 MOV #SECONDARY,R3 JSR PC,CH$COPY BR 36$ ; 1547 35$: CLR R5 ; DEFAULT.LENGTH 1570 36$: MOV #SECONDARY,R4 ; 1575 JSR PC,FSS MOV R5,20(SP) BEQ 40$ ; 1576 37$: MOV #SECONDARY,PRIMARY ; 1583 38$: MOV #PRI.PB,R1 ; 1584 JSR PC,SAVE.PARSE MOV #-3440,PRI.PB ; 1585 39$: JMP 73$ ; 1578 40$: TST SCR.PB+16 ; 1591 BEQ 41$ CMP SCR.PB+14,#2 ; 1592 BEQ 41$ BIT #7,SCR.PB+2 ; 1593 BEQ 48$ 41$: MOV #H.DUIC+1,R1 ; 1616 ADD 10(SP),R1 MOV R1,R0 MOV #H.DUIC,R2 ; 1617 ADD 10(SP),R2 MOV R2,R1 MOV $SAHDB,KISAR6 ; 1619 MOV #SECONDARY,R5 ; *,DIR.PTR 1620 MOVB #133,(R5)+ ; *,DIR.PTR 1621 BITB #300,(R0) ; 1627 BEQ 42$ MOVB (R0),R2 ; 1630 ASH #-6,R2 BIC #177774,R2 ADD #60,R2 MOVB R2,(R5)+ ; *,DIR.PTR BR 43$ ; 1631 42$: BITB #70,(R0) ; 1634 BEQ 44$ 43$: MOVB (R0),R2 ASH #-3,R2 BIC #177770,R2 ADD #60,R2 MOVB R2,(R5)+ ; *,DIR.PTR 44$: MOVB (R0),R2 ; 1635 BIC #177770,R2 ADD #60,R2 MOVB R2,(R5)+ ; *,DIR.PTR MOVB #54,(R5)+ ; *,DIR.PTR 1637 BITB #300,(R1) ; 1642 BEQ 45$ MOVB (R1),R0 ; 1645 ASH #-6,R0 BIC #177774,R0 ADD #60,R0 MOVB R0,(R5)+ ; *,DIR.PTR BR 46$ ; 1646 45$: BITB #70,(R1) ; 1649 BEQ 47$ 46$: MOVB (R1),R0 ASH #-3,R0 BIC #177770,R0 ADD #60,R0 MOVB R0,(R5)+ ; *,DIR.PTR 47$: MOVB (R1),R0 ; 1650 BIC #177770,R0 ADD #60,R0 MOVB R0,(R5)+ ; *,DIR.PTR MOVB #135,(R5)+ ; *,DIR.PTR 1655 SUB #SECONDARY,R5 ; 1660 MOV #SECONDARY,R4 JSR PC,FSS 48$: BIT #1,16(SP) ; *,MERGE.DIRECTORY 1666 BEQ 62$ MOV PRI.PB+16,R2 ; *,USER.DIR 1685 INC R2 ; USER.DIR MOV SCR.PB+36,R5 ; *,DEFAULT.DIR 1686 SUB #2,R5 ; *,DEFAULT.DIR MOV SCR.PB+36,R1 ; 1693 MOVB -1(R1),R0 ; *,BRACKET MOV SCR.PB+16,R4 ; 1719 49$: CMPB (R2),#55 ; USER.DIR,* 1699 BNE 52$ INC R2 ; USER.DIR 1701 CMPB (R5),#56 ; DEFAULT.DIR,* 1706 BEQ 59$ ; 1708 50$: CMP R5,R4 ; DEFAULT.DIR,* 1719 BEQ 49$ ; 1721 CMPB (R5),#56 ; DEFAULT.DIR,* 1723 BNE 51$ DEC R5 ; DEFAULT.DIR 1726 BR 49$ ; 1725 51$: DEC R5 ; DEFAULT.DIR 1730 BR 50$ ; 1713 52$: CMPB (R5),#56 ; DEFAULT.DIR,* 1738 BEQ 59$ ; 1740 MOV PRI.PB+16,R1 ; 1778 ADD PRI.PB+14,R1 DEC R1 CMP R5,R4 ; DEFAULT.DIR,* 1745 BNE 55$ CMPB (R2),#56 ; USER.DIR,* 1755 BNE 53$ INC R2 ; USER.DIR 1762 CMPB (R2),#56 ; USER.DIR,* 1768 BNE 53$ DEC R2 ; USER.DIR 1770 53$: CMP R2,R1 ; USER.DIR,* 1778 BNE 57$ MOV #6,R3 ; *,I 1781 54$: INC R5 ; DEFAULT.DIR 1783 MOVB #60,(R5) ; *,DEFAULT.DIR 1784 SOB R3,54$ ; I,* 1781 BR 56$ ; 1745 55$: CMP R2,R1 ; USER.DIR,* 1797 BEQ 58$ CMPB (R2),#56 ; USER.DIR,* 1799 BEQ 56$ INC R5 ; DEFAULT.DIR 1802 MOVB #56,(R5) ; *,DEFAULT.DIR 1803 56$: CMP R2,R1 ; USER.DIR,* 1812 BEQ 58$ 57$: INC R5 ; DEFAULT.DIR 1814 MOVB (R2)+,(R5) ; USER.DIR,DEFAULT.DIR 1815 BR 56$ ; 1812 58$: INC R5 ; DEFAULT.DIR 1823 MOVB R0,(R5) ; BRACKET,DEFAULT.DIR 1824 SUB R4,R5 ; 1825 INC R5 MOV #SECONDARY,R4 JSR PC,FSS MOV R5,20(SP) BEQ 60$ ; 1831 59$: MOV #-720,R3 ; 1833 MOV R3,PRI.PB BR 61$ ; 1831 60$: MOV #1,R3 61$: CMP R3,#1 ; STATUS,* 1842 BEQ 62$ MOV #SECONDARY,PRIMARY ; 1849 MOV #PRI.PB,R1 ; 1850 JSR PC,SAVE.PARSE MOV R3,PRI.PB ; STATUS,* 1851 BR 73$ ; 1844 62$: CLR PRI.PB+14 ; 1860 CLR PRI.PB+16 ; 1861 JSR PC,MERGE ; 1862 63$: MOVB #40,SECONDARY ; 1874 CLR R0 ; DO.MERGE 1875 MOV 14(SP),R2 ; 1876 MOV 26(R2),R1 BIT #400,R1 BEQ 64$ CLR PRI.PB+6 ; 1879 CLR PRI.PB+4 ; 1880 MOV #1,R0 ; *,DO.MERGE 1881 64$: TSTB R1 ; 1883 BPL 65$ CLR PRI.PB+12 ; 1886 CLR PRI.PB+10 ; 1887 MOV #1,R0 ; *,DO.MERGE 1888 65$: CMPB @PRI.PB+12,#137 ; 1894 BNE 66$ INC PRI.PB+12 ; 1897 DEC PRI.PB+10 ; 1898 MOV #1,R0 ; *,DO.MERGE 1899 66$: BIT #100,R1 ; 1902 BEQ 67$ CLR PRI.PB+16 ; 1905 CLR PRI.PB+14 ; 1906 MOV #1,R0 ; *,DO.MERGE 1907 67$: BIT #4,R1 ; 1909 BEQ 68$ CLR PRI.PB+22 ; 1912 CLR PRI.PB+20 ; 1913 MOV #1,R0 ; *,DO.MERGE 1914 68$: BIT #2,R1 ; 1921 BEQ 69$ CLR PRI.PB+26 ; 1924 CLR PRI.PB+24 ; 1925 BR 70$ ; 1926 69$: BIT #1,DO.DIRECTORY.DEFAULTING ; 1929 BEQ 71$ BIT #10000,R1 BNE 71$ MOVB #56,SECONDARY ; 1932 70$: MOV #1,R0 ; *,DO.MERGE 1933 71$: ROR R1 ; 1936 BCC 72$ CLR PRI.PB+32 ; 1939 CLR PRI.PB+30 ; 1940 MOV #1,R0 ; *,DO.MERGE 1941 72$: ROR R0 ; DO.MERGE 1943 BCC 73$ MOV #SECONDARY,R4 ; 1945 MOV #1,R5 JSR PC,FSS JSR PC,MERGE ; 1946 73$: BIT #1,MUST.HAVE.DEVICE ; 1958 BEQ 74$ JMP 89$ 74$: MOV 14(SP),R0 ; 1961 MOV 14(R0),4(SP) ; *,B.ADDR MOV PRI.PB+36,R0 ; 1962 BEQ 75$ SUB PRIMARY,R0 ; 1964 ADD PRI.PB+34,R0 MOV R0,R3 ; *,RES.LENGTH BR 76$ ; 1962 75$: CLR R3 ; RES.LENGTH 1966 76$: TST 4(SP) ; B.ADDR 1968 BEQ 78$ MOV 4(SP),R0 ; B.ADDR,* 1971 MOV #2,R1 JSR PC,$ACHKB BHIS 77$ TRAP 236 77$: MOV 4(SP),R0 ; B.ADDR,* 1972 JSR PC,$RELOM MOV R0,R4 ; *,P MOV R3,(R4) ; RES.LENGTH,P 1973 78$: TST PRI.PB+30 ; 1980 BEQ 79$ MOVB #73,@PRI.PB+32 79$: MOV 14(SP),R0 ; 1985 MOV 10(R0),4(SP) ; *,B.ADDR MOV 12(R0),2(SP) ; *,B.LEN 1986 MOV 4(SP),R0 ; B.ADDR,* 1987 JSR PC,$RELOC MOV R1,R5 MOV R2,R4 MOV #PRI.PB,-(SP) ; 1988 MOV PRIMARY,-(SP) MOV 10(SP),-(SP) ; B.ADDR,* JSR PC,CONVERT.PARSE TST 10(SP) ; B.LEN 1990 BEQ 83$ TST 12(SP) ; B.ADDR 1994 BNE 80$ TRAP 236 80$: MOV 12(SP),R0 ; B.ADDR,* 2000 MOV 10(SP),R1 ; B.LEN,* JSR PC,$ACHKB BHIS 81$ TRAP 236 81$: TST R3 ; RES.LENGTH 2002 BEQ 83$ MOV R3,R0 ; RES.LENGTH,* CMP R0,10(SP) ; *,B.LEN BLOS 82$ MOV 10(SP),R0 ; B.LEN,* 82$: MOV KISAR5,R1 MOV PRIMARY,R2 MOV R5,R3 ; B.MAPPING,* JSR PC,$BLXIO 83$: MOV 30(SP),PRI.PB+2 ; FLAGS.FOR.USER,* 2009 BIT #1,CANNOT.HAVE.NODE ; 2010 BEQ 84$ TST PRI.PB+6 BEQ 84$ MOV #-270,PRI.PB ; 2011 84$: MOV 22(SP),R0 ; 2012 MOV 16(R0),12(SP) ; *,B.ADDR MOV 20(R0),10(SP) ; *,B.LEN 2013 BEQ 88$ ; 2015 TST 12(SP) ; B.ADDR 2019 BNE 85$ TRAP 236 85$: MOV 12(SP),R0 ; B.ADDR,* 2025 MOV 10(SP),R1 ; B.LEN,* JSR PC,$ACHKB BHIS 86$ TRAP 236 86$: MOV 12(SP),R0 ; B.ADDR,* 2027 JSR PC,$RELOC MOV R1,R5 MOV R2,12(SP) MOV 10(SP),R0 ; B.LEN,* 2028 CMP R0,#46 BLOS 87$ MOV #46,R0 87$: MOV KISAR5,R1 MOV #PRI.PB,R2 MOV R5,R3 ; B.MAPPING,* MOV 12(SP),R4 ; B.ADDR,* JSR PC,$BLXIO 88$: ADD #6,SP ; 1960 89$: TST 6(SP) ; ASSIGN.LUN.ERRO 2038 BEQ 90$ JSR PC,@6(SP) ; *,ASSIGN.LUN.ERRO 90$: CMP PRI.PB,#1 ; 2039 BEQ 91$ TRAP 353 91$: ADD #24,SP ; 1054 RTS PC ; Routine Size: 1014 words, Routine Base: $CODE$ + 1074 ; Maximum stack depth per invocation: 21 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 2043 1 %SBTTL 'Expand file specification' ; 2044 1 GLOBAL_FOR_DEBUG ; 2045 1 ROUTINE expand_filespec (dpb_ptr) : expand_filespec_l = ; 2046 1 ; 2047 1 !++ ; 2048 1 ! ; 2049 1 ! FUNCTIONAL DESCRIPTION: ; 2050 1 ! ; 2051 1 ! This routine expands a file specification by merging in the ; 2052 1 ! translations of any logicals present in the initial input. ; 2053 1 ! The string must be in the primary buffer. It must be parsed ; 2054 1 ! already. The output is in the primary buffer and in the primary ; 2055 1 ! parse block. ; 2056 1 ! ; 2057 1 ! The following algorithm is used: ; 2058 1 ! ; 2059 1 ! 1) Separate a potential logical from the string, and put it in a ; 2060 1 ! buffer. If there is no potential logical, return success. ; 2061 1 ! The primary buffer and parse block will always contain file elements ; 2062 1 ! that we know are not to be expanded. ; 2063 1 ! ; 2064 1 ! 2) Repeat until we run out of iterations: ; 2065 1 ! ; 2066 1 ! 2.1) Expand the logical ; 2067 1 ! 2.2) If a logical was found, copy the expand buffer to the secondary ; 2068 1 ! buffer. If not, copy the unexpanded logical to the secondary. ; 2069 1 ! Set the terminal logical flag if status was terminal. ; 2070 1 ! 2.3) Parse the secondary. ; 2071 1 ! 2.4) If the status of the expand was success, separate the logical ; 2072 1 ! from the rest of the string in the secondary. ; 2073 1 ! 2.5) If there is anything in the secondary buffer, merge it with the ; 2074 1 ! primary. ; 2075 1 ! 2.6) If the status of both the expand and the separate was success, ; 2076 1 ! go again; otherwise return success. ; 2077 1 ! ; 2078 1 ! 3.0) If we got here, too many iterations, return bad recursive. ; 2079 1 ! ; 2080 1 ! ; 2081 1 ! IMPLICIT INPUTS: ; 2082 1 ! ; 2083 1 ! The file specification parsed in the primary buffer and parse block. ; 2084 1 ! ; 2085 1 ! The translation inhibit mask. ; 2086 1 ! ; 2087 1 !-- ; 2088 1 ; 2089 2 BEGIN ; 2090 2 ; 2091 2 MAP ; 2092 2 dpb_ptr : REF VECTOR; ! Treat the DPB as a vector ; 2093 2 ; 2094 2 LOCAL ; 2095 2 eqv_ptr : REF VECTOR [, BYTE], ; 2096 2 eqv_len, ; 2097 2 status, ; 2098 2 mstatus; ; 2099 2 ; 2100 2 OWN ; 2101 2 log_hold : VECTOR [ logical_size, BYTE], ; 2102 2 log_len; ; 2103 2 ; 2104 2 ROUTINE separate_logical ( dpb_ptr, parse_block ) : separate_logical_l = ; 2105 2 ; 2106 2 !++ ; 2107 2 ! ; 2108 2 ! FUNCTIONAL DESCRIPTION: ; 2109 2 ! ; 2110 2 ! This routine strips off the element of the string that could be a ; 2111 2 ! logical and puts it in a special buffer to be used for logical ; 2112 2 ! expansion. It takes the parse block of the string to be processed as ; 2113 2 ! input. It returns success if an element has been removed from the ; 2114 2 ! string, and failure if the string has not been modified. ; 2115 2 ! ; 2116 2 !-- ; 2117 2 ; 2118 3 BEGIN ; 2119 3 ; 2120 3 MAP ; 2121 3 parse_block : REF BLOCK FIELD (parse_block_f), ; 2122 3 dpb_ptr : REF VECTOR; ! Treat the DPB as a vector ; 2123 3 ; 2124 3 ! Strip off the logical and put it in log_hold, with the length in log_len. ; 2125 3 ; 2126 3 CASE .parse_block [logical_type] from logical_type_none TO logical_type_node OF ; 2127 3 SET ; 2128 3 ; 2129 3 [logical_type_node] : ; 2130 3 IF (.dpb_ptr [11] AND FS$NOD) EQLU 0 ; 2131 3 THEN ; 2132 4 BEGIN ; 2133 4 ! ; 2134 4 ! A node specification is present - it may be a logical ; 2135 4 ! ; 2136 4 ch$copy (.parse_block [node_len], .parse_block [node_addr], log_hold [0]; log_len); ; 2137 4 parse_block [node_addr] = 0; ; 2138 4 parse_block [node_len] = 0; ; 2139 4 parse_block [access_addr] = 0; ; 2140 4 parse_block [access_len] = 0; ; 2141 4 parse_block [flags] = .parse_block [flags] AND NOT FS$NOD; !PKW117 ; 2142 4 END ; 2143 3 ELSE ; 2144 3 RETURN error; ; 2145 3 ; 2146 3 [logical_type_device] : ; 2147 3 IF (.dpb_ptr [11] AND FS$DEV) EQLU 0 ; 2148 3 THEN ; 2149 4 BEGIN ; 2150 4 ! ; 2151 4 ! A device specification is present - it may be a logical ; 2152 4 ! ; 2153 4 ch$copy (.parse_block [device_len], .parse_block [device_addr], log_hold [0]; log_len); ; 2154 4 parse_block [device_addr] = 0; ; 2155 4 parse_block [device_len] = 0; ; 2156 4 parse_block [flags] = .parse_block [flags] AND NOT FS$DEV; ; 2157 4 END ; 2158 3 ELSE ; 2159 3 RETURN error; ; 2160 3 ; 2161 3 [logical_type_filename] : ; 2162 3 IF (.dpb_ptr [11] AND FS$NAM) EQLU 0 ; 2163 3 THEN ; 2164 4 BEGIN ; 2165 4 ! ; 2166 4 ! A standalone filename specification is present - it may be a logical ; 2167 4 ! ; 2168 4 ch$copy (.parse_block [filename_len], .parse_block [filename_addr], log_hold [0]; log_len); ; 2169 4 parse_block [filename_addr] = 0; ; 2170 4 parse_block [filename_len] = 0; ; 2171 4 parse_block [flags] = .parse_block [flags] AND NOT (FS$NAM OR FS$WNA); ; 2172 4 END ; 2173 3 ELSE ; 2174 3 RETURN error; ; 2175 3 ; 2176 3 [logical_type_none] : ; 2177 3 RETURN error; ; 2178 3 TES; ; 2179 3 ; 2180 3 log_len = .log_len - log_hold [0]; ; 2181 3 RETURN success; ; 2182 3 ; 2183 2 END; ! Routine separate_logical .NLIST .LIST BIN,LOC .LIST .PSECT $OWN$, D LOG.HOLD: .BLKB 377 .EVEN LOG.LEN:.BLKW 1 .SBTTL SEPARATE.LOGICAL Expand file specification .PSECT $CODE$, RO .NLIST .ENABL LSB .LIST SEPARATE.LOGICAL: JSR R1,$SAVE3 ; 2104 CLR R0 ; 2126 BISB 44(R4),R0 ; *(PARSE.BLOCK),* ASL R0 ADD P.AAA(R0),PC ; Case dispatch 2$: BIT #400,26(R3) ; *,*(DPB.PTR) 2130 BNE 6$ MOV 4(R4),R1 ; *(PARSE.BLOCK),* 2136 MOV 6(R4),R2 ; *(PARSE.BLOCK),* MOV #LOG.HOLD,R3 JSR PC,CH$COPY MOV R3,LOG.LEN CLR 6(R4) ; *(PARSE.BLOCK) 2137 CLR 4(R4) ; *(PARSE.BLOCK) 2138 CLR 42(R4) ; *(PARSE.BLOCK) 2139 CLR 40(R4) ; *(PARSE.BLOCK) 2140 BIC #400,2(R4) ; *,*(PARSE.BLOCK) 2141 BR 5$ ; 2130 3$: TSTB 26(R3) ; *(DPB.PTR) 2147 BMI 6$ MOV 10(R4),R1 ; *(PARSE.BLOCK),* 2153 MOV 12(R4),R2 ; *(PARSE.BLOCK),* MOV #LOG.HOLD,R3 JSR PC,CH$COPY MOV R3,LOG.LEN CLR 12(R4) ; *(PARSE.BLOCK) 2154 CLR 10(R4) ; *(PARSE.BLOCK) 2155 BIC #200,2(R4) ; *,*(PARSE.BLOCK) 2156 BR 5$ ; 2147 4$: BIT #4,26(R3) ; *,*(DPB.PTR) 2162 BNE 6$ MOV 20(R4),R1 ; *(PARSE.BLOCK),* 2168 MOV 22(R4),R2 ; *(PARSE.BLOCK),* MOV #LOG.HOLD,R3 JSR PC,CH$COPY MOV R3,LOG.LEN CLR 22(R4) ; *(PARSE.BLOCK) 2169 CLR 20(R4) ; *(PARSE.BLOCK) 2170 BIC #44,2(R4) ; *,*(PARSE.BLOCK) 2171 5$: SUB #LOG.HOLD,LOG.LEN ; 2180 MOV #1,R0 ; 2118 RTS PC 6$: CLR R0 ; 2104 RTS PC ; Routine Size: 84 words, Routine Base: $CODE$ + 5050 ; Maximum stack depth per invocation: 5 words .PSECT $PLIT$, RO , D P.AAA: ; CASE Table for SEPARATE.LOGICA+0014 2126 1$: .WORD 224 ; [6$] .WORD 136 ; [4$] .WORD 64 ; [3$] .WORD 0 ; [2$] .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 2184 2 ; 2185 2 terminal_logical_flag = false; ! Init the flag to not terminal ; 2186 2 status = separate_logical ( .dpb_ptr, pri_pb ); ! Strip off the logical in the initial input ; 2187 2 IF .status EQLU success THEN ; 2188 2 ! ; 2189 2 ! For no more than the maximum interation count, translate and merge, ; 2190 2 ! if possible ; 2191 2 ! ; 2192 3 BEGIN ; 2193 3 DECR i FROM iteration_max TO 1 DO ; 2194 4 BEGIN ; 2195 4 ! I assume that the status returned will be success, error, ; 2196 4 ! or the successful status of terminal ; 2197 4 ! ; 2198 4 status = find_equivalence (log_hold [0], .log_len; eqv_ptr, eqv_len); ; 2199 4 IF .status EQLU error THEN ; 2200 4 ch$copy (.log_len, log_hold [0], secondary [0]; eqv_ptr) ; 2201 4 ELSE ; 2202 5 BEGIN ; 2203 5 ch$copy (.eqv_len, .eqv_ptr, secondary [0]; eqv_ptr); ; 2204 5 IF .status EQLU terminal THEN ; 2205 5 terminal_logical_flag = true; ; 2206 4 END; ; 2207 4 fss (secondary [0], .eqv_ptr - secondary [0]; eqv_ptr, eqv_len); ; 2208 4 IF .eqv_len NEQU 0 ; 2209 4 THEN ; 2210 5 BEGIN ; 2211 5 ; 2212 5 ! ; 2213 5 ! Settup the bad string for return. ; 2214 5 ! ; 2215 5 merge(); ; 2216 5 RETURN pri_pb [fss_status] = bad_char; ! Settup the error code ; 2217 5 ; 2218 4 END; ; 2219 4 IF .status EQLU success THEN ; 2220 4 status = separate_logical ( .dpb_ptr, scr_pb ); ; 2221 4 IF (.scr_pb [node_len] NEQU 0) OR (.scr_pb [device_len] NEQU 0) OR (.scr_pb [directory_len] NEQU 0) OR ; 2222 4 (.scr_pb [filename_len] NEQU 0) OR (.scr_pb [type_len] NEQU 0) OR (.scr_pb [version_len] NEQU 0) OR ; 2223 4 (.scr_pb [trailing_len] NEQU 0) OR (.scr_pb [access_len] NEQU 0) THEN ; 2224 5 BEGIN ; 2225 5 mstatus = merge(); ; 2226 5 IF .mstatus NEQU success THEN RETURN pri_pb [fss_status] = .mstatus; ; 2227 4 END; ; 2228 4 IF .status NEQU success THEN RETURN success; ; 2229 3 END; ; 2230 3 ! ; 2231 3 ! If we got here, then the number of iterations exceeded iteration_max ; 2232 3 ! ; 2233 3 RETURN pri_pb [fss_status] = bad_recursive; ! Return error code ; 2234 3 END ; 2235 2 ELSE ; 2236 2 RETURN success; ; 2237 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL EXPAND.FILESPEC Expand file specification .PSECT $CODE$, RO .NLIST .ENABL LSB .LIST EXPAND.FILESPEC: JSR R1,$SAVE5 ; 2045 SUB #14,SP MOV R3,12(SP) CLR TERMINAL.LOGICAL.FLAG ; 2185 MOV #PRI.PB,R4 ; 2186 JSR PC,SEPARATE.LOGICAL MOV R0,10(SP) ; *,STATUS CMP R0,#1 ; STATUS,* 2187 BNE 9$ MOV #12,6(SP) ; *,I 2193 1$: MOV #LOG.HOLD,R1 ; 2198 MOV LOG.LEN,R2 JSR PC,FIND.EQUIVALENCE MOV R0,10(SP) ; *,STATUS MOV R1,2(SP) MOV R2,(SP) TST R0 ; STATUS 2199 BNE 2$ MOV LOG.LEN,R1 ; 2200 MOV #LOG.HOLD,R2 MOV #SECONDARY,R3 JSR PC,CH$COPY MOV R3,2(SP) BR 3$ ; 2199 2$: MOV (SP),R1 ; EQV.LEN,* 2203 MOV 2(SP),R2 ; EQV.PTR,* MOV #SECONDARY,R3 JSR PC,CH$COPY MOV R3,2(SP) CMP 10(SP),#3 ; STATUS,* 2204 BNE 3$ MOV #1,TERMINAL.LOGICAL.FLAG ; 2205 3$: MOV 2(SP),R1 ; EQV.PTR,* 2207 SUB #SECONDARY,R1 MOV #SECONDARY,R4 MOV R1,R5 JSR PC,FSS MOV R4,2(SP) MOV R5,(SP) BEQ 4$ ; 2208 JSR PC,MERGE ; 2215 MOV #-3440,R0 ; 2216 BR 8$ 4$: CMP 10(SP),#1 ; STATUS,* 2219 BNE 5$ MOV 12(SP),R3 ; 2220 MOV #SCR.PB,R4 JSR PC,SEPARATE.LOGICAL MOV R0,10(SP) ; *,STATUS 5$: TST SCR.PB+4 ; 2221 BNE 6$ TST SCR.PB+10 BNE 6$ TST SCR.PB+14 BNE 6$ TST SCR.PB+20 ; 2222 BNE 6$ TST SCR.PB+24 BNE 6$ TST SCR.PB+30 BNE 6$ TST SCR.PB+34 ; 2223 BNE 6$ TST SCR.PB+40 BEQ 7$ 6$: JSR PC,MERGE ; 2225 MOV R0,4(SP) ; *,MSTATUS CMP R0,#1 ; MSTATUS,* 2226 BNE 8$ 7$: CMP 10(SP),#1 ; STATUS,* 2228 BNE 9$ DEC 6(SP) ; I 2193 BNE 1$ MOV #-3230,R0 ; 2233 8$: MOV R0,PRI.PB BR 10$ ; 2236 9$: MOV #1,R0 10$: ADD #14,SP ; 2045 RTS PC ; Routine Size: 138 words, Routine Base: $CODE$ + 5320 ; Maximum stack depth per invocation: 13 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 2238 1 ; 2240 1 %SBTTL 'Merge file specifications' ; 2241 1 GLOBAL_FOR_DEBUG ; 2242 1 ROUTINE merge = ; 2243 1 ; 2244 1 !++ ; 2245 1 ! ; 2246 1 ! FUNCTIONAL DESCRIPTION: ; 2247 1 ! ; 2248 1 ! Merge the primary and secondary file specifications. For each ; 2249 1 ! component of the file specification, copy the piece found in the ; 2250 1 ! primary if present, or copy the piece from the secondary. The ; 2251 1 ! result is put in merged. At the end the primary string is the ; 2252 1 ! merged result and the primary parse block is filled in. ; 2253 1 ! ; 2254 1 ! The handling of a file specification containing a quoted string ; 2255 1 ! is slightly different. A quoted string name in the primary string ; 2256 1 ! inhibits the inclusion of both the filename and type, and the version ; 2257 1 ! if a node name is present. ; 2258 1 ! ; 2259 1 ! IMPLICIT INPUTS: ; 2260 1 ! ; 2261 1 ! Buffers and parse blocks. ; 2262 1 ! ; 2263 1 ! IMPLICIT OUTPUTS: ; 2264 1 ! ; 2265 1 ! The primary parse block is updated. ; 2266 1 ! ; 2267 1 !-- ; 2268 1 ; 2269 2 BEGIN ; 2270 2 ; 2271 2 ! ; 2272 2 ! A node spec followed by a quoted string with nothing else should not ; 2273 2 ! have anything merged into it other than a node name on the local node. ; 2274 2 ! ; 2275 3 IF ((.pri_pb [flags] AND (FS$VER OR FS$TYP OR FS$NAM OR FS$DIR OR FS$DEV OR FS$NOD OR FS$QUO)) EQLU ; 2276 3 (FS$NOD OR FS$QUO OR FS$NAM OR FS$TYP)) ; 2277 3 ; 2278 2 OR ; 2279 2 ; 2280 2 ! ; 2281 2 ! If the primary string has has anything other than a node and the ; 2282 2 ! secondary string is a node name followed by a quoted string then ; 2283 2 ! everything in the secondary string except for the node should be ; 2284 2 ! gotten rid of. ; 2285 2 ! ; 2286 2 ; 2287 2 ((.pri_pb [flags] AND (FS$DIR OR FS$NAM OR FS$TYP OR FS$VER OR FS$QUO)) NEQU 0) AND ; 2288 3 ((.scr_pb [flags] AND (FS$VER OR FS$TYP OR FS$NAM OR FS$DIR OR FS$DEV OR FS$NOD OR FS$QUO)) EQLU ; 2289 3 (FS$NOD OR FS$QUO OR FS$NAM OR FS$TYP)) ; 2290 2 THEN ; 2291 3 BEGIN ; 2292 3 scr_pb [device_addr] = 0; ; 2293 3 scr_pb [device_len] = 0; ; 2294 3 scr_pb [directory_addr] = 0; ; 2295 3 scr_pb [directory_len] = 0; ; 2296 3 scr_pb [filename_addr] = 0; ; 2297 3 scr_pb [filename_len] = 0; ; 2298 3 scr_pb [type_addr] = 0; ; 2299 3 scr_pb [type_len] = 0; ; 2300 3 scr_pb [version_addr] = 0; ; 2301 3 scr_pb [version_len] = 0; ; 2302 3 IF .scr_pb [logical_type] NEQU logical_type_node ; 2303 3 THEN ; 2304 3 scr_pb [logical_type] = logical_type_none; ; 2305 2 END; ; 2306 2 ; 2307 2 ! ; 2308 2 ! Copy the lengths and pointers into the primary parse block for all ; 2309 2 ! parts of the file specification to be used. In the process, form the ; 2310 2 ! updated status mask. We are only going to set bits in the status. ; 2311 2 ! ; 2312 2 IF .pri_pb [node_len] EQLU 0 ; 2313 2 THEN ; 2314 2 ; 2315 2 IF (pri_pb [node_len] = .scr_pb [node_len]) NEQU 0 ; 2316 2 THEN ; 2317 3 BEGIN ; 2318 3 pri_pb [flags] = .pri_pb [flags] OR FS$NOD; ; 2319 3 pri_pb [node_addr] = .scr_pb [node_addr]; ; 2320 3 pri_pb [access_len] = .scr_pb [access_len]; ; 2321 3 pri_pb [access_addr] = .scr_pb [access_addr]; ; 2322 2 END; ; 2323 2 ; 2324 2 IF .pri_pb [device_len] EQLU 0 ; 2325 2 THEN ; 2326 2 ; 2327 2 IF (pri_pb [device_len] = .scr_pb [device_len]) NEQU 0 ; 2328 2 THEN ; 2329 3 BEGIN ; 2330 3 pri_pb [flags] = .pri_pb [flags] OR FS$DEV; ; 2331 3 pri_pb [device_addr] = .scr_pb [device_addr]; ; 2332 2 END; ; 2333 2 ; 2334 2 IF .pri_pb [directory_len] EQLU 0 ; 2335 2 THEN ; 2336 2 ; 2337 2 IF (pri_pb [directory_len] = .scr_pb [directory_len]) NEQU 0 ; 2338 2 THEN ; 2339 3 BEGIN ; 2340 3 pri_pb [flags] = .pri_pb [flags] OR (.scr_pb [flags] AND (FS$DIR OR FS$WDI)); ; 2341 3 pri_pb [directory_addr] = .scr_pb [directory_addr]; ; 2342 2 END; ; 2343 2 ; 2344 2 IF ((.pri_pb [flags] OR .scr_pb [flags]) AND FS$QUO) EQLU 0 ; 2345 2 THEN ; 2346 3 BEGIN ; 2347 3 ; 2348 3 ! ; 2349 3 ! Here because neither string contains a quoted ; 2350 3 ! filespec. Handle the filename, type, and version ; 2351 3 ! in the usual way. ; 2352 3 ! ; 2353 3 IF .pri_pb [filename_len] EQLU 0 ; 2354 3 THEN ; 2355 3 ; 2356 3 IF (pri_pb [filename_len] = .scr_pb [filename_len]) NEQU 0 ; 2357 3 THEN ; 2358 4 BEGIN ; 2359 4 pri_pb [flags] = .pri_pb [flags] OR (.scr_pb [flags] AND (FS$NAM OR FS$WNA)); ; 2360 4 pri_pb [filename_addr] = .scr_pb [filename_addr]; ; 2361 3 END; ; 2362 3 ; 2363 3 IF .pri_pb [type_len] EQLU 0 ; 2364 3 THEN ; 2365 3 ; 2366 3 IF (pri_pb [type_len] = .scr_pb [type_len]) NEQU 0 ; 2367 3 THEN ; 2368 4 BEGIN ; 2369 4 pri_pb [flags] = .pri_pb [flags] OR (.scr_pb [flags] AND (FS$TYP OR FS$WTY)); ; 2370 4 pri_pb [type_addr] = .scr_pb [type_addr]; ; 2371 3 END; ; 2372 3 ; 2373 3 IF .pri_pb [version_len] EQLU 0 ; 2374 3 THEN ; 2375 3 ; 2376 3 IF (pri_pb [version_len] = .scr_pb [version_len]) NEQU 0 ; 2377 3 THEN ; 2378 4 BEGIN ; 2379 4 pri_pb [flags] = .pri_pb [flags] OR (.scr_pb [flags] AND (FS$VER OR FS$WVE)); ; 2380 4 pri_pb [version_addr] = .scr_pb [version_addr]; ; 2381 3 END; ; 2382 3 ; 2383 3 END ; 2384 2 ELSE ; 2385 3 BEGIN ; 2386 3 ; 2387 3 ! ; 2388 3 ! We are here because one or the other (or both) of the primary and ; 2389 3 ! secondary strings contain a quoted file specification. If the ; 2390 3 ! primary string contains either a filename or type then don't copy ; 2391 3 ! either the filename or type from the secondary. ; 2392 3 ! If addition, if the primary includes a node name and the primary ; 2393 3 ! has a filename, then don't copy the version number from the secondary. ; 2394 3 ! ; 2395 3 IF .pri_pb [filename_len] EQLU 0 AND .pri_pb [type_len] EQLU 0 ; 2396 3 THEN ; 2397 4 BEGIN ; 2398 4 ; 2399 4 ! ; 2400 4 ! We are here because the primary string has no filename ; 2401 4 ! or type and the secondary string has a quoted filename. ; 2402 4 ! In this case the merged string will contain the quoted ; 2403 4 ! filespec from the secondary. ; 2404 4 ! ; 2405 4 pri_pb [flags] = .pri_pb [flags] OR FS$NAM OR FS$QUO OR FS$TYP; ; 2406 4 pri_pb [filename_len] = .scr_pb [filename_len]; ; 2407 4 pri_pb [filename_addr] = .scr_pb [filename_addr]; ; 2408 3 END; ; 2409 3 ; 2410 3 ! ; 2411 3 ! If the primary string has no version the version from the ; 2412 3 ! secondary string will be merged in if there is one. ; 2413 3 ! ; 2414 3 IF .pri_pb [node_len] EQLU 0 AND .pri_pb [version_len] EQLU 0 ; 2415 3 THEN ; 2416 3 IF (pri_pb [version_len] = .scr_pb [version_len]) NEQU 0 ; 2417 3 THEN ; 2418 4 BEGIN ; 2419 4 pri_pb [flags] = .pri_pb [flags] OR (.scr_pb [flags] AND (FS$VER OR FS$WVE)); ; 2420 4 pri_pb [version_addr] = .scr_pb [version_addr]; ; 2421 3 END; ; 2422 3 ; 2423 2 END; ; 2424 2 ; 2425 3 BEGIN ; 2426 3 ; 2427 3 ! ; 2428 3 ! Copy each of the substrings into the output buffer ; 2429 3 ! and update the pointers to point to the new buffer. ; 2430 3 ! ; 2431 3 LOCAL ; 2432 3 pri_pb_p : REF VECTOR, ! Pointer to primary parse block ; 2433 3 status, ! Merge status ; 2434 3 current_len, ; 2435 3 total_len, ; 2436 3 temp; ; 2437 3 ; 2438 3 REGISTER ; 2439 3 o_ptr; ; 2440 3 ; 2441 3 total_len = 0; ; 2442 3 status = 1; ; 2443 3 pri_pb [trailing_len] = 0; ; 2444 3 pri_pb [trailing_addr] = 0; ; 2445 3 pri_pb_p = pri_pb [fss_status]; ; 2446 3 o_ptr = merged [0]; ; 2447 3 ; 2448 3 INCRU i FROM 0 TO 5*2 BY 2 DO ; 2449 4 BEGIN ; 2450 4 current_len = .pri_pb_p [.i + 2]; ! Get the length ; 2451 4 total_len = .total_len + .current_len; ; 2452 4 ; 2453 4 IF .total_len GTRU file_spec_size ; 2454 4 THEN ; 2455 5 BEGIN ; 2456 5 ; 2457 5 ! ; 2458 5 ! Copy as much as will fit, then update the parse block to ; 2459 5 ! reflect the actual amount returned. I'm not sure if this ; 2460 5 ! exactly the best way of dealing with the problem... ; 2461 5 ! How do you determine the real length needed? ; 2462 5 ! Here's how.... We will initialize the length of the ; 2463 5 ! trailing string to 0 and on completion store the address ; 2464 5 ! of the next character following. This will make it ; 2465 5 ! easy to determine the length of the expanded string; ; 2466 5 ! just subtract the buffer beginning from [trailing_addr]. ; 2467 5 ! For the cases where the buffer overflows, we'll update ; 2468 5 ! the length to include the amount that wouldn't fit. ; 2469 5 ! ; 2470 5 pri_pb [trailing_addr] = merged [0] + file_spec_size; ! Get address of one past buffer ; 2471 5 pri_pb [trailing_len] = .total_len - file_spec_size; ! Set to the amount attempted ; 2472 5 ; 2473 5 IF (current_len = .current_len - .pri_pb [trailing_len]) LSS 0 THEN current_len = 0; ; 2474 5 ; 2475 5 ! Can't be less than 0 ; 2476 5 status = bad_size; ! Set eventual status ; 2477 4 END; ; 2478 4 ; 2479 5 BEGIN ; 2480 5 ; 2481 5 LOCAL ; 2482 5 i_ptr; ; 2483 5 ; 2484 5 i_ptr = .pri_pb_p [.i + 2 + 1]; ! Get the address ; 2485 5 IF .i_ptr NEQA 0 THEN pri_pb_p [.i + 2 + 1] = .o_ptr; ! Update the address ; 2486 5 ch$move (.current_len, i_ptr, o_ptr); ! Move the string ; 2487 4 END; ; 2488 4 ; 2489 3 END; ! INCR ; 2490 3 ; 2491 3 ! ; 2492 3 ! If the trailing length is non zero leave the trailing address alone ; 2493 3 ! because it has been settup by an overflow condition. Otherwise settup ; 2494 3 ! the trailing address. ; 2495 3 ! ; 2496 3 IF .pri_pb [trailing_len] EQLU 0 THEN pri_pb [trailing_addr] = merged [0] + .total_len; ; 2497 3 ; 2498 3 ! ; 2499 3 ! Settup the access control string information. ; 2500 3 ! ; 2501 3 IF .pri_pb [access_len] NEQU 0 ; 2502 3 THEN ; 2503 3 pri_pb [access_addr] = .pri_pb [node_addr] + .pri_pb [node_len] - .pri_pb [access_len] - 2; ; 2504 3 ; 2505 3 ! ; 2506 3 ! Update the logical type. Make it the max of the two. ; 2507 3 ! ; 2508 3 pri_pb [logical_type] = maxu (.pri_pb [logical_type], .scr_pb [logical_type]); ; 2509 3 pri_pb [fss_status] = .status; ; 2510 3 temp = merged [0]; ! Switch primary and merged buffers ; 2511 3 merged = primary [0]; ; 2512 3 primary = .temp; ; 2513 3 RETURN .status; ; 2514 2 END; ; 2515 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL MERGE Merge file specifications .NLIST .ENABL LSB .LIST MERGE: JSR R1,$SAVE5 ; 2242 CMP -(SP),-(SP) MOV PRI.PB+2,R0 ; 2275 BIC #175070,R0 CMP R0,#2406 BEQ 1$ BIT #2107,PRI.PB+2 ; 2287 BEQ 2$ MOV SCR.PB+2,R0 ; 2288 BIC #175070,R0 CMP R0,#2406 BNE 2$ 1$: CLR SCR.PB+12 ; 2292 CLR SCR.PB+10 ; 2293 CLR SCR.PB+16 ; 2294 CLR SCR.PB+14 ; 2295 CLR SCR.PB+22 ; 2296 CLR SCR.PB+20 ; 2297 CLR SCR.PB+26 ; 2298 CLR SCR.PB+24 ; 2299 CLR SCR.PB+32 ; 2300 CLR SCR.PB+30 ; 2301 CMPB SCR.PB+44,#3 ; 2302 BEQ 2$ CLRB SCR.PB+44 ; 2304 2$: TST PRI.PB+4 ; 2312 BNE 3$ MOV SCR.PB+4,PRI.PB+4 ; 2315 BEQ 3$ BIS #400,PRI.PB+2 ; 2318 MOV SCR.PB+6,PRI.PB+6 ; 2319 MOV SCR.PB+40,PRI.PB+40 ; 2320 MOV SCR.PB+42,PRI.PB+42 ; 2321 3$: TST PRI.PB+10 ; 2324 BNE 4$ MOV SCR.PB+10,PRI.PB+10 ; 2327 BEQ 4$ BIS #200,PRI.PB+2 ; 2330 MOV SCR.PB+12,PRI.PB+12 ; 2331 4$: TST PRI.PB+14 ; 2334 BNE 5$ MOV SCR.PB+14,PRI.PB+14 ; 2337 BEQ 5$ MOV SCR.PB+2,R0 ; 2340 BIC #176677,R0 BIS R0,PRI.PB+2 MOV SCR.PB+16,PRI.PB+16 ; 2341 5$: MOV PRI.PB+20,R0 ; 2353 MOV PRI.PB+2,R1 ; 2344 BIS SCR.PB+2,R1 BIT #2000,R1 BNE 7$ TST R0 ; 2353 BNE 6$ MOV SCR.PB+20,PRI.PB+20 ; 2356 BEQ 6$ MOV SCR.PB+2,R0 ; 2359 BIC #177733,R0 BIS R0,PRI.PB+2 MOV SCR.PB+22,PRI.PB+22 ; 2360 6$: TST PRI.PB+24 ; 2363 BNE 9$ MOV SCR.PB+24,PRI.PB+24 ; 2366 BEQ 9$ MOV SCR.PB+2,R0 ; 2369 BIC #177755,R0 BIS R0,PRI.PB+2 MOV SCR.PB+26,PRI.PB+26 ; 2370 BR 9$ ; 2373 7$: TST R0 ; 2395 BNE 8$ TST PRI.PB+24 BNE 8$ BIS #2006,PRI.PB+2 ; 2405 MOV SCR.PB+20,PRI.PB+20 ; 2406 MOV SCR.PB+22,PRI.PB+22 ; 2407 8$: TST PRI.PB+4 ; 2414 BNE 10$ 9$: TST PRI.PB+30 BNE 10$ MOV SCR.PB+30,PRI.PB+30 ; 2416 BEQ 10$ MOV SCR.PB+2,R0 ; 2419 BIC #177766,R0 BIS R0,PRI.PB+2 MOV SCR.PB+32,PRI.PB+32 ; 2420 10$: CLR R4 ; TOTAL.LEN 2441 MOV #1,(SP) ; *,STATUS 2442 CLR PRI.PB+34 ; 2443 CLR PRI.PB+36 ; 2444 MOV #PRI.PB,2(SP) ; *,PRI.PB.P 2445 MOV MERGED,R0 ; *,O.PTR 2446 CLR R5 ; I 2448 11$: MOV R5,R1 ; I,* 2450 ASL R1 ADD 2(SP),R1 ; PRI.PB.P,* MOV 4(R1),R3 ; *,CURRENT.LEN ADD R3,R4 ; CURRENT.LEN,TOTAL.LEN 2451 CMP R4,#377 ; TOTAL.LEN,* 2453 BLOS 13$ MOV MERGED,PRI.PB+36 ; 2470 ADD #377,PRI.PB+36 MOV R4,PRI.PB+34 ; TOTAL.LEN,* 2471 SUB #377,PRI.PB+34 SUB PRI.PB+34,R3 ; *,CURRENT.LEN 2473 BPL 12$ CLR R3 ; CURRENT.LEN 12$: MOV #-1414,(SP) ; *,STATUS 2476 13$: MOV R5,R1 ; I,* 2484 ASL R1 ADD 2(SP),R1 ; PRI.PB.P,* MOV 6(R1),R2 ; *,I.PTR BEQ 14$ ; 2485 MOV R0,6(R1) ; O.PTR,* 14$: TST R3 ; CURRENT.LEN 2486 BEQ 16$ MOV R3,R1 ; CURRENT.LEN,I BLE 16$ 15$: MOVB (R2)+,(R0)+ ; I.PTR,O.PTR SOB R1,15$ ; I,* 16$: ADD #2,R5 ; *,I 2448 CMP R5,#12 ; I,* BLOS 11$ TST PRI.PB+34 ; 2496 BNE 17$ MOV R4,PRI.PB+36 ; TOTAL.LEN,* ADD MERGED,PRI.PB+36 17$: MOV PRI.PB+40,R1 ; 2501 BEQ 18$ MOV PRI.PB+6,R2 ; 2503 ADD PRI.PB+4,R2 SUB R1,R2 MOV R2,PRI.PB+42 SUB #2,PRI.PB+42 18$: CLR R1 ; 2508 BISB PRI.PB+44,R1 CLR R0 BISB SCR.PB+44,R0 CMP R1,R0 BHIS 19$ CLR R1 BISB SCR.PB+44,R1 19$: MOVB R1,PRI.PB+44 MOV (SP),PRI.PB ; STATUS,* 2509 MOV MERGED,R1 ; *,TEMP 2510 MOV PRIMARY,MERGED ; 2511 MOV R1,PRIMARY ; TEMP,* 2512 MOV (SP)+,R0 ; STATUS,* 2269 TST (SP)+ ; 2242 RTS PC ; Routine Size: 275 words, Routine Base: $CODE$ + 5744 ; Maximum stack depth per invocation: 9 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 2516 1 %SBTTL 'Parse file specification' ; 2517 1 GLOBAL_FOR_DEBUG ; 2518 1 ROUTINE fss (ptr_p, len_p; ptr, len) : fss_l NOVALUE= ; 2519 1 ; 2520 1 !++ ; 2521 1 ! ; 2522 1 ! FUNCTIONAL DESCRIPTION: ; 2523 1 ! ; 2524 1 ! Scan the input string for a valid file specification. On exit, ; 2525 1 ! either it has scanned the entire string, the scan was terminated ; 2526 1 ! by something that may or may not be a valid terminator, or a ; 2527 1 ! syntax error was discovered. ; 2528 1 ! ; 2529 1 ! Spaces are not allowed in the file specification for two reasons; ; 2530 1 ! any reasonable external use for this routine will be in a DCL like ; 2531 1 ! command language or similar where spaces are parameter delimiters ; 2532 1 ! or it is being used to perform a parse merge. In this case, some ; 2533 1 ! preprocessing has almost certainly been done; in the case of this ; 2534 1 ! module, the string has been compressed. ; 2535 1 ! ; 2536 1 ! FORMAL PARAMETERS: ; 2537 1 ! ; 2538 1 ! ptr_p ; 2539 1 ! address of the input string ; 2540 1 ! ; 2541 1 ! len_p ; 2542 1 ! length of the string ; 2543 1 ! ; 2544 1 ! IMPLICIT OUTPUTS: ; 2545 1 ! ; 2546 1 ! The scratch parse block is filled in. ; 2547 1 ! ; 2548 1 !-- ; 2549 1 ; 2550 2 BEGIN ; 2551 2 ; 2552 2 MACRO ; 2553 2 ; 2554 2 ! ; 2555 2 ! NEXT_CHAR sets the next character and returns true if success ; 2556 2 ! ; M 2557 2 next_char = ; M 2558 2 BEGIN ; M 2559 2 char = .(.ptr)<0, 8, 1>; ; M 2560 2 ptr = .ptr + 1; ; M 2561 2 .ptr LEQA .end_ptr ; 2562 2 END %; ; 2563 2 ; 2564 2 REGISTER ; 2565 2 char; ! Character being examined ; 2566 2 ; 2567 2 LOCAL ; 2568 2 status, ! Routine status ; 2569 2 backup_ptr, ! Restart point if current state fails to transit ; 2570 2 end_ptr; ! End of input pointer ; 2571 2 ; 2572 2 LABEL ; 2573 2 main_scan, ; 2574 2 filename_scan, ; 2575 2 node_scan; ; 2576 2 ; 2577 2 save_parse (scr_pb); ! Init the scratch parse block ; 2578 2 ptr = .ptr_p; ; 2579 2 end_ptr = .ptr + .len_p; ; 2580 2 ; 2581 2 main_scan : ; 2582 3 BEGIN ; 2583 3 node_scan : ; 2584 4 BEGIN ! Process a node specification ; 2585 4 ; 2586 4 ! ; 2587 4 ! Process all node specifications ; 2588 4 ! ; 2589 4 ! No errors are returned by this section. We don't really have enough ; 2590 4 ! information, with the possible exception of unterminated access ; 2591 4 ! control string. We'll pick that up later as a bad filename. ; 2592 4 ! ; 2593 4 ! While the node specification will include all node specifications, ; 2594 4 ! the access control string will only include the first quoted string ; 2595 4 ! plus colons, or if no access control, just the colons. This will ; 2596 4 ! be used to merge any node logical name translation, which of course ; 2597 4 ! is only performed on the first specification. ; 2598 4 ! ; 2599 4 LOCAL ; 2600 4 node_count; ; 2601 4 ; 2602 4 node_count = 0; ; 2603 4 backup_ptr = .ptr; ; 2604 4 ; 2605 4 WHILE 1 DO ; 2606 5 BEGIN ; 2607 5 ; 2608 5 LOCAL ; 2609 5 access_ptr; ; 2610 5 ; 2611 5 ! ; 2612 5 ! If there are no more characters backup to the start of this ; 2613 5 ! substring and exit this loop; its not a node specification. ; 2614 5 ! ; 2615 5 access_ptr = .ptr; ; 2616 5 ; 2617 6 IF NOT next_char ; 2618 5 THEN ; 2619 6 BEGIN ; 2620 6 ptr = .backup_ptr; ; 2621 6 EXITLOOP; ; 2622 5 END; ; 2623 5 ; 2624 5 CASE ch$classify (.char) FROM 0 TO ch_max OF ; 2625 5 SET ; 2626 5 ; 2627 5 [ch_alpha, ch_dollar, ch_under, ch_lower, ch_oct, ch_8and9] : ; 2628 5 ; 2629 5 ! ; 2630 5 ! The character is valid in a node name, do the next character ; 2631 5 ! ; 2632 5 ; ; 2633 5 ; 2634 5 [ch_colon] : ; 2635 5 ; 2636 5 ! ; 2637 5 ! A node specification is terminated by double colons; ; 2638 5 ! is the next character also a colon ? ; 2639 5 ! ; 2640 6 BEGIN ; 2641 6 ; 2642 7 IF NOT next_char ; 2643 6 THEN ; 2644 7 BEGIN ; 2645 7 ptr = .backup_ptr; ; 2646 7 EXITLOOP; ; 2647 6 END; ; 2648 6 ; 2649 6 IF .char NEQU %C':' ; 2650 6 THEN ; 2651 7 BEGIN ; 2652 7 ptr = .backup_ptr; ; 2653 7 EXITLOOP; ; 2654 6 END; ; 2655 6 ; 2656 6 ! ; 2657 6 ! We have parsed a node specification; save this knowledge ; 2658 6 ! but let's not get carried away and lose the knowledge we have ; 2659 6 ! about the first one we found if poor man's routing is being used. ; 2660 6 ! ; 2661 6 IF .node_count EQLU 0 ; 2662 6 THEN ; 2663 7 BEGIN ; 2664 7 scr_pb [node_addr] = .backup_ptr; ; 2665 7 scr_pb [node_len] = .ptr - .backup_ptr; ; 2666 7 scr_pb [access_addr] = .access_ptr; ; 2667 7 scr_pb [access_len] = .ptr - .access_ptr - 2; ; 2668 7 scr_pb [flags] = .scr_pb [flags] OR FS$NOD; ; 2669 7 scr_pb [logical_type] = logical_type_node; ; 2670 7 END ; 2671 6 ELSE ; 2672 6 scr_pb [node_len] = .ptr - .scr_pb [node_addr]; ; 2673 6 ; 2674 6 backup_ptr = .ptr; ; 2675 6 node_count = .node_count + 1; ; 2676 5 END; ; 2677 5 ; 2678 5 [ch_quote] : ; 2679 5 ; 2680 5 ! ; 2681 5 ! Must be the start of an access control string. ; 2682 5 ! ; 2683 6 BEGIN ; 2684 6 ; 2685 6 LOCAL ; 2686 6 state; ; 2687 6 ; 2688 6 ptr = .ptr - 1; ! backup pointer to quote ; 2689 6 access_ptr = .ptr; ! Save address of access control string ; 2690 6 ; 2691 6 ! ; 2692 6 ! Can't be a node specification if null string ; 2693 6 ! ; 2694 6 IF .ptr EQLU .backup_ptr THEN EXITLOOP; ; 2695 6 ; 2696 6 state = 0; ! Initial state is unquoted ; 2697 6 ; 2698 6 WHILE 1 DO ; 2699 7 BEGIN ; 2700 7 ; 2701 7 ! ; 2702 7 ! Get the next character. If none then exit this loop ; 2703 7 ! and determine quote level. ; 2704 7 ! ; 2705 8 IF NOT next_char ; 2706 7 THEN ; 2707 8 BEGIN ; 2708 8 ; 2709 8 ! ; 2710 8 ! If we ran out of input, then its not a node specification ; 2711 8 ! ; 2712 8 ptr = .backup_ptr; ; 2713 8 LEAVE node_scan; ; 2714 7 END; ; 2715 7 ; 2716 7 IF .char EQLU %C'"' ; 2717 7 THEN ; 2718 7 state = NOT .state ; 2719 7 ELSE ; 2720 7 ; 2721 7 IF .state EQLU 0 THEN EXITLOOP; ; 2722 7 ; 2723 6 END; ; 2724 6 ; 2725 6 ! ; 2726 6 ! The access control string must be terminated by double colons ; 2727 6 ! ; 2728 6 IF .char NEQU %C':' ; 2729 6 THEN ; 2730 7 BEGIN ; 2731 7 ptr = .backup_ptr; ; 2732 7 EXITLOOP; ; 2733 6 END; ; 2734 6 ; 2735 7 IF NOT next_char ; 2736 6 THEN ; 2737 7 BEGIN ; 2738 7 ptr = .backup_ptr; ; 2739 7 EXITLOOP; ; 2740 6 END; ; 2741 6 ; 2742 6 IF .char NEQU %C':' ; 2743 6 THEN ; 2744 7 BEGIN ; 2745 7 ptr = .backup_ptr; ; 2746 7 EXITLOOP; ; 2747 6 END; ; 2748 6 ; 2749 6 ! ; 2750 6 ! We have parsed a node specification; save this knowledge ; 2751 6 ! but let's not get carried away and lose the knowledge we have ; 2752 6 ! about the first one we found if poor man's routing is being used. ; 2753 6 ! ; 2754 6 IF .node_count EQLU 0 ; 2755 6 THEN ; 2756 7 BEGIN ; 2757 7 scr_pb [node_addr] = .backup_ptr; ; 2758 7 scr_pb [node_len] = .ptr - .backup_ptr; ; 2759 7 scr_pb [access_addr] = .access_ptr; ; 2760 7 scr_pb [access_len] = .ptr - .access_ptr - 2; ; 2761 7 scr_pb [flags] = .scr_pb [flags] OR FS$NOD; ; 2762 7 scr_pb [logical_type] = logical_type_node; ; 2763 7 END ; 2764 6 ELSE ; 2765 6 scr_pb [node_len] = .ptr - .scr_pb [node_addr]; ; 2766 6 ; 2767 6 backup_ptr = .ptr; ; 2768 6 node_count = .node_count + 1; ; 2769 5 END; ! Process access control string ; 2770 5 ; 2771 5 [INRANGE] : ; 2772 5 ; 2773 5 ! ; 2774 5 ! Either an invalid character has been encountered or we ; 2775 5 ! aren't processing a node specification. Backup to the ; 2776 5 ! beginning of the string and exit this loop. ; 2777 5 ! ; 2778 6 BEGIN ; 2779 6 ptr = .backup_ptr; ; 2780 6 EXITLOOP; ; 2781 5 END; ; 2782 5 TES; ; 2783 5 ; 2784 4 END; ; 2785 4 ; 2786 3 END; ! Process a node specification ; 2787 4 BEGIN ! Process a device specification ; 2788 4 ! ; 2789 4 ! Attempt to process a device specification. The next character has not been ; 2790 4 ! fetched at the beginning nor end of the block. ; 2791 4 ! ; 2792 4 ! No errors are detected in this scan. If we don't find what we're looking ; 2793 4 ! for, its most likely because we're not looking at a device specification. ; 2794 4 ! If we don't like what we see, we just backup to the start and go on to ; 2795 4 ! the next section. ; 2796 4 ! ; 2797 4 backup_ptr = .ptr; ; 2798 4 ; 2799 4 WHILE 1 DO ; 2800 5 BEGIN ; 2801 5 ; 2802 5 ! ; 2803 5 ! If there are no more characters backup to the start of this ; 2804 5 ! substring and exit this loop. ; 2805 5 ! ; 2806 6 IF NOT next_char ; 2807 5 THEN ; 2808 6 BEGIN ; 2809 6 ptr = .backup_ptr; ; 2810 6 EXITLOOP; ; 2811 5 END; ; 2812 5 ; 2813 5 CASE ch$classify (.char) FROM 0 TO ch_max OF ; 2814 5 SET ; 2815 5 ; 2816 5 [ch_alpha, ch_dollar, ch_under, ch_lower, ch_oct, ch_8and9] : ; 2817 5 ; 2818 5 ! ; 2819 5 ! The character is valid in a device name, do the next character ; 2820 5 ! ; 2821 5 ; ; 2822 5 ; 2823 5 [ch_colon] : ; 2824 5 ; 2825 5 ! ; 2826 5 ! This is the terminating character of a device name ; 2827 5 ! ; 2828 6 BEGIN ; 2829 6 ; 2830 6 IF .ptr - .backup_ptr GTRU 1 ; 2831 6 THEN ; 2832 7 BEGIN ; 2833 7 ; 2834 7 ! ; 2835 7 ! We've got a valid device specification, save this knowledge ; 2836 7 ! ; 2837 7 scr_pb [device_addr] = .backup_ptr; ; 2838 7 scr_pb [device_len] = .ptr - .backup_ptr; ; 2839 7 scr_pb [flags] = .scr_pb [flags] OR FS$DEV; ; 2840 7 ; 2841 7 IF .scr_pb [logical_type] eqlu logical_type_none ; 2842 7 then ; 2843 7 scr_pb [logical_type] = logical_type_device; ; 2844 7 ; 2845 7 END ; 2846 6 ELSE ; 2847 6 ; 2848 6 ! ; 2849 6 ! Not long enough, backup and let it fail later ; 2850 6 ! ; 2851 6 ptr = .backup_ptr; ; 2852 6 ; 2853 6 EXITLOOP; ; 2854 5 END; ; 2855 5 ; 2856 5 [INRANGE] : ; 2857 5 ; 2858 5 ! ; 2859 5 ! Either an invalid character has been encountered or we ; 2860 5 ! aren't processing a device specification. Backup to the ; 2861 5 ! beginning of the string and exit this loop. ; 2862 5 ! ; 2863 6 BEGIN ; 2864 6 ptr = .backup_ptr; ; 2865 6 EXITLOOP; ; 2866 5 END; ; 2867 5 TES; ; 2868 5 ; 2869 4 END; ; 2870 4 ; 2871 3 END; ! Process a device specification ; 2872 4 BEGIN ! Process a file specification ; 2873 4 ! ; 2874 4 ! Process a directory specification. ; 2875 4 ! ; 2876 4 ! We are immediately able to determine if we have a directory specification ; 2877 4 ! at this point; the current character must be either a '<' or '['. ; 2878 4 ! If we don't find the matching bracket, we will report an error. ; 2879 4 ! Likewise if we don't like some of the characters scanned. ; 2880 4 ! ; 2881 5 BEGIN ! Process a directory specification ; 2882 5 ; 2883 5 ! ; 2884 5 ! Attempt to process a directory specification ; 2885 5 ! ; 2886 5 ; 2887 5 LOCAL ; 2888 5 bracket; ; 2889 5 ; 2890 5 backup_ptr = .ptr; ! Save start of this part of string for error return ; 2891 5 ; 2892 5 IF NOT next_char THEN LEAVE main_scan; ; 2893 5 ; 2894 5 bracket = 0; ; 2895 5 ; 2896 5 SELECT .char OF ; 2897 5 SET ; 2898 5 ; 2899 5 [%C'['] : ; 2900 5 ; 2901 5 ! ; 2902 5 ! Standard directory brackets, set terminating bracket. ; 2903 5 ! ; 2904 5 bracket = %C']'; ; 2905 5 ; 2906 5 [%C'<'] : ; 2907 5 ; 2908 5 ! ; 2909 5 ! Alternate brackets, set terminating bracket. ; 2910 5 ! ; 2911 5 bracket = %C'>'; ; 2912 5 TES; ; 2913 5 ; 2914 5 IF .bracket NEQU 0 ; 2915 5 THEN ; 2916 6 BEGIN ! Process directory specification ; 2917 6 ; 2918 6 LOCAL ; 2919 6 state; ; 2920 6 ; 2921 6 state = 0; ; 2922 6 ; 2923 7 IF NOT (WHILE 1 DO ; 2924 8 BEGIN ! Scan directory specification ; 2925 8 ; 2926 8 ! ; 2927 8 ! Get the next character, if none then right bracket ; 2928 8 ! missing, terminate scan with an error indication. ; 2929 8 ! ; 2930 8 IF NOT next_char THEN LEAVE main_scan; ; 2931 8 ; 2932 8 CASE ch$classify (.char) FROM 0 TO ch_max OF ; 2933 8 SET ; 2934 8 ; 2935 8 [ch_alpha, ch_dollar, ch_under, ch_lower, ch_oct, ch_8and9, ch_dash] : ; 2936 8 ; 2937 8 ! ; 2938 8 ! These characters are valid in the new format. ; 2939 8 ! ; 2940 8 ; ; 2941 8 ; 2942 8 [ch_dot] : ; 2943 8 ; 2944 8 ! ; 2945 8 ! Check for ... which is wild. ; 2946 8 ! ; 2947 8 ; 2948 9 IF next_char ! Is there another character? ; 2949 8 THEN ; 2950 8 IF .char EQLU %C'.' ! Is it a .? ; 2951 8 THEN ; 2952 9 IF next_char ! Is there a third? ; 2953 8 THEN ; 2954 8 IF .char EQLU %C'.' ! Is it a .? ; 2955 8 THEN ; 2956 8 scr_pb [flags] = .scr_pb [flags] OR FS$WDI ; 2957 8 ELSE ; 2958 8 LEAVE main_scan ! .. invalid, no directory ; 2959 8 ELSE ; 2960 8 LEAVE main_scan ! We are looking at junk ; 2961 8 ELSE ; 2962 8 ptr = .ptr - 1 ! . followed by something else ; 2963 8 ELSE ; 2964 8 LEAVE main_scan; ! We are looking at junk ; 2965 8 ; 2966 8 [ch_wild] : ; 2967 8 ; 2968 8 ! ; 2969 8 ! Indicate wild directory ; 2970 8 ! ; 2971 8 scr_pb [flags] = .scr_pb [flags] OR FS$WDI; ; 2972 8 ; 2973 8 [ch_dir] : ; 2974 8 ; 2975 8 ! ; 2976 8 ! End of directory specification, exit loop if matching bracket ; 2977 8 ! ; 2978 8 IF .char EQLU .bracket THEN EXITLOOP valid ELSE EXITLOOP error; ; 2979 8 ; 2980 8 [INRANGE] : ; 2981 8 ; 2982 8 ! ; 2983 8 ! Invalid character encountered, terminate scan with ; 2984 8 ! an error indication. We will rescan to determine ; 2985 8 ! if the specification is in the UIC form. ; 2986 8 ! ; 2987 8 EXITLOOP error; ; 2988 8 TES; ; 2989 8 ; 2990 8 END ! Scan directory specification ; 2991 7 ) ; 2992 6 THEN ; 2993 7 BEGIN ; 2994 7 ptr = .backup_ptr + 1; ; 2995 7 ; 2996 7 WHILE 1 DO ! Process group,member format directory ; 2997 8 BEGIN ; 2998 8 ; 2999 8 IF NOT next_char THEN LEAVE main_scan; ; 3000 8 ; 3001 8 CASE ch$classify (.char) FROM 0 TO ch_max OF ; 3002 8 SET ; 3003 8 ; 3004 8 [ch_oct, ch_8and9] : ; 3005 8 ; 3006 8 ! ; 3007 8 ! Digits are valid ; 3008 8 ! ; 3009 8 ; ; 3010 8 ; 3011 8 [ch_wild] : ; 3012 8 ; 3013 8 ! ; 3014 8 ! Indicate wild directory ; 3015 8 ! ; 3016 8 scr_pb [flags] = .scr_pb [flags] OR FS$WDI; ; 3017 8 ; 3018 8 [ch_comma] : ; 3019 8 ; 3020 8 ! ; 3021 8 ! Group-member separator encountered. Only one is legal. ; 3022 8 ! Set flag indicating that a comma was encountered. ; 3023 8 ! ; 3024 8 IF (state = NOT .state) EQLU 0 THEN LEAVE main_scan; ; 3025 8 ; 3026 8 [ch_dir] : ; 3027 8 ; 3028 8 ! ; 3029 8 ! End of directory specification, exit loop. ; 3030 8 ! ; 3031 9 BEGIN ; 3032 9 ; 3033 9 IF .char NEQU .bracket OR .state EQLU 0 THEN LEAVE main_scan; ; 3034 9 ; 3035 9 EXITLOOP; ; 3036 8 END; ; 3037 8 ; 3038 8 [INRANGE] : ; 3039 8 ; 3040 8 ! ; 3041 8 ! Invalid character encountered, exit the loop with an error ; 3042 8 ! ; 3043 8 LEAVE main_scan; ; 3044 8 TES; ; 3045 8 ; 3046 8 END ! Process group,member directory specification ; 3047 6 END; ; 3048 6 ; 3049 6 ! ; 3050 6 ! We have located a directory specification, save this knowledge ; 3051 6 ! ; 3052 6 scr_pb [directory_addr] = .backup_ptr; ; 3053 6 scr_pb [directory_len] = .ptr - .backup_ptr; ; 3054 6 scr_pb [flags] = .scr_pb [flags] OR FS$DIR; ; 3055 6 backup_ptr = .ptr; ! Save start of remaining string for error return ; 3056 5 END; ! Process directory specification ; 3057 5 ; 3058 4 END; ! Process a directory spec ; 3059 4 filename_scan : ; 3060 5 BEGIN ! Process filename ; 3061 5 ! ; 3062 5 ! Attempt to process a filename specification. ; 3063 5 ! ; 3064 5 ! We will first attempt to process a quoted string. ; 3065 5 ! ; 3066 5 ! If we don't find a quoted string, then we will attempt to process ; 3067 5 ! a normal file specification. ; 3068 5 ! ; 3069 5 LOCAL ; 3070 5 state; ; 3071 5 ; 3072 5 state = 0; ; 3073 5 ; 3074 5 ! ; 3075 5 ! Attempt to process a funny filename (ANSI). ; 3076 5 ! ; 3077 5 ptr = .backup_ptr; ! Backup to start of remaining string ; 3078 5 ; 3079 5 WHILE 1 DO ; 3080 6 BEGIN ; 3081 6 ; 3082 6 ! ; 3083 6 ! Get the next character. If none then the command is valid. ; 3084 6 ! ; 3085 6 IF NOT next_char THEN EXITLOOP; ; 3086 6 ; 3087 6 IF .char EQLU %C'"' ; 3088 6 THEN ; 3089 6 state = NOT .state ; 3090 6 ELSE ; 3091 6 IF .state EQLU 0 THEN EXITLOOP; ; 3092 5 END; ; 3093 5 ; 3094 5 state = -1; ! Initialize state again ; 3095 5 ptr = .ptr - 1; ! Backup to next character ; 3096 5 ; 3097 5 IF .ptr NEQU .backup_ptr ; 3098 5 THEN ; 3099 6 BEGIN ; 3100 6 ; 3101 6 ! ; 3102 6 ! We actually have a quoted file specification, save this knowledge ; 3103 6 ! ; 3104 6 scr_pb [filename_addr] = .backup_ptr; ; 3105 6 scr_pb [filename_len] = .ptr - .backup_ptr; ; 3106 6 scr_pb [flags] = .scr_pb [flags] OR FS$QUO OR FS$NAM OR FS$TYP; ; 3107 6 END ; 3108 5 ELSE ; 3109 6 BEGIN ! Process a normal filename ; 3110 6 ; 3111 6 WHILE 1 DO ; 3112 7 BEGIN ! Scan filename specification ; 3113 7 ; 3114 7 IF NOT next_char THEN EXITLOOP; ; 3115 7 ; 3116 7 CASE ch$classify (.char) FROM 0 TO ch_max OF ; 3117 7 SET ; 3118 7 ; 3119 7 [ch_alpha, ch_dollar, ch_under, ch_lower, ch_oct, ch_8and9] : ; 3120 7 ; 3121 7 ! ; 3122 7 ! Valid character encountered, process next character ; 3123 7 ! ; 3124 7 ; ; 3125 7 ; 3126 7 ! ; 3127 7 ! Note that a wildcard has been encountered ; 3128 7 ! ; 3129 7 [ch_wild] : ; 3130 7 ; 3131 7 ! ; 3132 7 ! Note that a wildcard has been encountered ; 3133 7 ! ; 3134 7 scr_pb [flags] = .scr_pb [flags] OR ; 3135 8 BEGIN ; 3136 8 IF .state LSS 0 THEN FS$WNA ELSE FS$WTY ; 3137 7 END; ; 3138 7 ; 3139 7 [ch_dot] : ; 3140 7 ; 3141 7 ! ; 3142 7 ! The first dot is the type field delimiter, ; 3143 7 ! the second is the new version delimiter. ; 3144 7 ! Exit if the version delimiter. ; 3145 7 ! ; 3146 7 IF (state = .state + 1) EQLU 0 ; 3147 7 THEN ; 3148 8 BEGIN ; 3149 8 IF (scr_pb [filename_len] = .ptr - 1 - .backup_ptr) NEQU 0 ; 3150 8 THEN ; 3151 9 BEGIN ; 3152 9 scr_pb [filename_addr] = .backup_ptr; ; 3153 9 scr_pb [flags] = .scr_pb [flags] OR FS$NAM; ; 3154 8 END; ; 3155 8 backup_ptr = .ptr - 1; ; 3156 8 END ; 3157 7 ELSE ; 3158 7 EXITLOOP; ; 3159 7 ; 3160 7 [INRANGE] : ; 3161 7 ; 3162 7 ! ; 3163 7 ! Any other character is not valid in the file ; 3164 7 ! name or type fields. Exit loop to the version ; 3165 7 ! processing scan. ; 3166 7 ! ; 3167 7 EXITLOOP; ; 3168 7 TES; ; 3169 7 ; 3170 6 END; ! Scan filename specification ; 3171 6 ; 3172 6 ptr = .ptr - 1; ! Backup to next character ; 3173 6 ; 3174 6 IF .state LSS 0 ; 3175 6 THEN ; 3176 7 BEGIN ; 3177 7 ; 3178 7 IF (scr_pb [filename_len] = .ptr - .backup_ptr) NEQU 0 ; 3179 7 THEN ; 3180 8 BEGIN ; 3181 8 scr_pb [filename_addr] = .backup_ptr; ; 3182 8 scr_pb [flags] = .scr_pb [flags] OR FS$NAM; ; 3183 7 END; ; 3184 7 ; 3185 7 END ; 3186 6 ELSE ; 3187 7 BEGIN ; 3188 7 scr_pb [type_addr] = .backup_ptr; ; 3189 7 scr_pb [type_len] = .ptr - .backup_ptr; ; 3190 7 scr_pb [flags] = .scr_pb [flags] OR FS$TYP; ; 3191 6 END; ; 3192 6 ; 3193 5 END; ! Process a normal filename ; 3194 5 ; 3195 4 END; ! filename_scan ; 3196 4 backup_ptr = .ptr; ; 3197 4 IF NOT next_char THEN LEAVE main_scan; ; 3198 4 ; 3199 4 SELECTONEU .char OF ; 3200 4 SET ; 3201 4 ; 3202 4 [%C'.', %C';'] : ; 3203 4 ; 3204 4 ! ; 3205 4 ! Process version number ; 3206 4 ! ; 3207 5 BEGIN ; 3208 5 ; 3209 5 LOCAL ; 3210 5 state; ; 3211 5 ; 3212 5 state = 0; ! State is the character count or wildcard flag if -1 ; 3213 5 ; 3214 5 WHILE 1 DO ; 3215 6 BEGIN ; 3216 6 ; 3217 6 ! ; 3218 6 ! Get next character. If none command line valid. ; 3219 6 ! ; 3220 6 IF NOT next_char THEN EXITLOOP; ; 3221 6 ; 3222 6 SELECTONEU .char OF ; 3223 6 SET ; 3224 6 ; 3225 6 [%C'0' TO %C'9'] : ; 3226 6 ; 3227 6 ! ; 3228 6 ! If number then continue skipping over version number ; 3229 6 ! ; 3230 6 IF (state = .state + 1) EQLU 0 THEN LEAVE main_scan; ; 3231 6 ; 3232 6 [%C'-'] : ; 3233 6 ; 3234 6 ! ; 3235 6 ! Minus sign only valid if first character of version number. ; 3236 6 ! ; 3237 7 BEGIN ; 3238 7 ; 3239 7 IF .state NEQU 0 THEN LEAVE main_scan; ; 3240 7 ; 3241 7 state = .state + 1; ; 3242 6 END; ; 3243 6 ; 3244 6 [%C'*'] : ; 3245 6 ; 3246 6 ! ; 3247 6 ! Wildcard version number. Must be only character in version number. ; 3248 6 ! ; 3249 7 BEGIN ; 3250 7 ; 3251 7 IF .state NEQU 0 THEN LEAVE main_scan; ; 3252 7 ; 3253 7 state = NOT .state; ; 3254 6 END; ; 3255 6 ; 3256 6 [OTHERWISE] : ; 3257 6 ; 3258 6 ! ; 3259 6 ! Non-digit encountered, exit version scan. ; 3260 6 ! ; 3261 6 EXITLOOP; ; 3262 6 TES; ; 3263 6 ; 3264 5 END; ; 3265 5 ; 3266 5 ptr = .ptr - 1; ! Backup to next character ; 3267 5 ; 3268 5 ! ; 3269 5 ! We just processed a version number, save this knowledge ; 3270 5 ! ; 3271 5 ; 3272 5 IF .state LSS 0 THEN scr_pb [flags] = .scr_pb [flags] OR FS$WVE; ; 3273 5 ; 3274 5 scr_pb [flags] = .scr_pb [flags] OR FS$VER; ; 3275 5 scr_pb [version_addr] = .backup_ptr; ; 3276 5 scr_pb [version_len] = .ptr - .backup_ptr; ; 3277 5 backup_ptr = .ptr; ! Include the version number ; 3278 4 END; ; 3279 4 ; 3280 4 [OTHERWISE] : ; 3281 4 ; 3282 4 ! ; 3283 4 ! Return the last character ; 3284 4 ! ; 3285 5 BEGIN ; 3286 5 ptr = .ptr - 1; ! Backup to next character ; 3287 4 END; ; 3288 4 TES ; 3289 4 ; 3290 3 END; ! Process filename specification ; 3291 2 END; ! main_scan ; 3292 2 scr_pb [trailing_addr] = ptr = .backup_ptr; ! Always fill in the address ; 3293 2 scr_pb [trailing_len] = len = .end_ptr - .ptr; ! of the traling string even if null ; 3294 2 ; 3295 2 IF (.scr_pb [flags] NEQU 0) AND (.scr_pb [flags] AND NOT FS$NAM) EQLU 0 ! If a standalone filename is ; 3296 2 THEN ! present it could be a logical ; 3297 2 scr_pb [logical_type] = logical_type_filename; ; 3298 2 ; 3299 2 scr_pb [fss_status] = valid; ; 3300 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL FSS Parse file specification .NLIST .ENABL LSB .LIST FSS: JSR R1,$SAVE3 ; 2518 TST -(SP) MOV #SCR.PB,R1 ; 2577 JSR PC,SAVE.PARSE MOV R5,R3 ; LEN.P,END.PTR 2579 ADD R4,R3 ; PTR,END.PTR CLR (SP) ; NODE.COUNT 2602 MOV R4,R2 ; PTR,BACKUP.PTR 2603 1$: MOV R4,R5 ; PTR,ACCESS.PTR 2615 MOVB (R4)+,R1 ; PTR,CHAR 2617 CMP R4,R3 ; PTR,END.PTR BHI 9$ ; 2620 JSR PC,CH$CLASSIFY ; 2624 ASL R0 ADD P.AAB(R0),PC ; Case dispatch 3$: DEC R4 ; PTR 2688 MOV R4,R5 ; PTR,ACCESS.PTR 2689 CMP R4,R2 ; PTR,BACKUP.PTR 2694 BEQ 10$ CLR R0 ; STATE 2696 4$: MOVB (R4)+,R1 ; PTR,CHAR 2705 CMP R4,R3 ; PTR,END.PTR BHI 9$ ; 2712 CMP R1,#42 ; CHAR,* 2716 BNE 5$ COM R0 ; STATE 2718 BR 4$ ; 2716 5$: TST R0 ; STATE 2721 BNE 4$ CMP R1,#72 ; CHAR,* 2728 BNE 9$ ; 2731 6$: MOVB (R4)+,R1 ; PTR,CHAR 2735 CMP R4,R3 ; PTR,END.PTR BHI 9$ ; 2738 CMP R1,#72 ; CHAR,* 2742 BNE 9$ ; 2745 TST (SP) ; NODE.COUNT 2754 BNE 7$ MOV R2,SCR.PB+6 ; BACKUP.PTR,* 2757 MOV R4,SCR.PB+4 ; PTR,* 2758 SUB R2,SCR.PB+4 ; BACKUP.PTR,* MOV R5,SCR.PB+42 ; ACCESS.PTR,* 2759 MOV R4,R0 ; PTR,* 2760 SUB R5,R0 ; ACCESS.PTR,* MOV R0,SCR.PB+40 SUB #2,SCR.PB+40 BIS #400,SCR.PB+2 ; 2761 MOVB #3,SCR.PB+44 ; 2762 BR 8$ ; 2754 7$: MOV R4,SCR.PB+4 ; PTR,* 2765 SUB SCR.PB+6,SCR.PB+4 8$: MOV R4,R2 ; PTR,BACKUP.PTR 2767 INC (SP) ; NODE.COUNT 2768 BR 1$ ; 2624 9$: MOV R2,R4 ; BACKUP.PTR,PTR 2779 10$: MOV R4,R2 ; PTR,BACKUP.PTR 2797 11$: MOVB (R4)+,R1 ; PTR,CHAR 2806 CMP R4,R3 ; PTR,END.PTR BHI 14$ ; 2809 JSR PC,CH$CLASSIFY ; 2813 ASL R0 ADD P.AAC(R0),PC ; Case dispatch 13$: MOV R4,R0 ; PTR,* 2830 SUB R2,R0 ; BACKUP.PTR,* CMP R0,#1 BLOS 14$ MOV R2,SCR.PB+12 ; BACKUP.PTR,* 2837 MOV R0,SCR.PB+10 ; 2838 BIS #200,SCR.PB+2 ; 2839 TSTB SCR.PB+44 ; 2841 BNE 15$ MOVB #2,SCR.PB+44 ; 2843 BR 15$ ; 2830 14$: MOV R2,R4 ; BACKUP.PTR,PTR 2864 15$: MOV R4,R2 ; PTR,BACKUP.PTR 2890 MOVB (R4)+,R1 ; PTR,CHAR 2892 CMP R4,R3 ; PTR,END.PTR BHI 30$ CLR R5 ; BRACKET 2894 CMP R1,#133 ; CHAR,* 2899 BNE 16$ MOV #135,R5 ; *,BRACKET 2904 16$: CMP R1,#74 ; CHAR,* 2906 BNE 17$ MOV #76,R5 ; *,BRACKET 2911 17$: TST R5 ; BRACKET 2914 BEQ 32$ CLR (SP) ; STATE 2921 18$: MOVB (R4)+,R1 ; PTR,CHAR 2930 CMP R4,R3 ; PTR,END.PTR BHI 30$ JSR PC,CH$CLASSIFY ; 2932 ASL R0 ADD P.AAD(R0),PC ; Case dispatch 20$: MOVB (R4)+,R1 ; PTR,CHAR 2948 CMP R4,R3 ; PTR,END.PTR BHI 30$ CMP R1,#56 ; CHAR,* 2950 BNE 21$ MOVB (R4)+,R1 ; PTR,CHAR 2952 CMP R4,R3 ; PTR,END.PTR BHI 30$ CMP R1,#56 ; CHAR,* 2954 BNE 30$ BR 22$ ; 2956 21$: DEC R4 ; PTR 2962 BR 18$ ; 2948 22$: BIS #1000,SCR.PB+2 ; 2971 BR 18$ ; 2932 23$: CMP R1,R5 ; CHAR,BRACKET 2978 BEQ 31$ 24$: MOV R2,R4 ; BACKUP.PTR,PTR 2994 INC R4 ; PTR 25$: MOVB (R4)+,R1 ; PTR,CHAR 2999 CMP R4,R3 ; PTR,END.PTR BHI 46$ JSR PC,CH$CLASSIFY ; 3001 ASL R0 ADD P.AAE(R0),PC ; Case dispatch 27$: BIS #1000,SCR.PB+2 ; 3016 BR 25$ ; 3001 28$: COM (SP) ; STATE 3024 BNE 25$ BR 49$ 29$: CMP R1,R5 ; CHAR,BRACKET 3033 30$: BNE 51$ TST (SP) ; STATE BEQ 49$ 31$: MOV R2,SCR.PB+16 ; BACKUP.PTR,* 3052 MOV R4,SCR.PB+14 ; PTR,* 3053 SUB R2,SCR.PB+14 ; BACKUP.PTR,* BIS #100,SCR.PB+2 ; 3054 MOV R4,R2 ; PTR,BACKUP.PTR 3055 32$: CLR R5 ; STATE 3072 MOV R2,R4 ; BACKUP.PTR,PTR 3077 33$: MOVB (R4)+,R1 ; PTR,CHAR 3085 CMP R4,R3 ; PTR,END.PTR BHI 35$ CMP R1,#42 ; CHAR,* 3087 BNE 34$ COM R5 ; STATE 3089 BR 33$ ; 3087 34$: TST R5 ; STATE 3091 BNE 33$ 35$: MOV #-1,R5 ; *,STATE 3094 DEC R4 ; PTR 3095 CMP R4,R2 ; PTR,BACKUP.PTR 3097 BEQ 36$ MOV R2,SCR.PB+22 ; BACKUP.PTR,* 3104 MOV R4,SCR.PB+20 ; PTR,* 3105 SUB R2,SCR.PB+20 ; BACKUP.PTR,* BIS #2006,SCR.PB+2 ; 3106 BR 45$ ; 3097 36$: MOVB (R4)+,R1 ; PTR,CHAR 3114 CMP R4,R3 ; PTR,END.PTR BHI 43$ JSR PC,CH$CLASSIFY ; 3116 ASL R0 ADD P.AAF(R0),PC ; Case dispatch 38$: TST R5 ; STATE 3136 BGE 39$ MOV #40,R0 ; 3135 BR 40$ 39$: MOV #20,R0 40$: BIS R0,SCR.PB+2 ; 3134 BR 36$ ; 3116 41$: INC R5 ; STATE 3146 BNE 43$ MOV R4,R0 ; PTR,* 3149 SUB R2,R0 ; BACKUP.PTR,* MOV R0,SCR.PB+20 DEC SCR.PB+20 BEQ 42$ MOV R2,SCR.PB+22 ; BACKUP.PTR,* 3152 BIS #4,SCR.PB+2 ; 3153 42$: MOV R4,R2 ; PTR,BACKUP.PTR 3155 DEC R2 ; BACKUP.PTR BR 36$ ; 3146 43$: DEC R4 ; PTR 3172 MOV R4,R0 ; PTR,* 3178 SUB R2,R0 ; BACKUP.PTR,* TST R5 ; STATE 3174 BGE 44$ MOV R0,SCR.PB+20 ; 3178 BEQ 45$ MOV R2,SCR.PB+22 ; BACKUP.PTR,* 3181 BIS #4,SCR.PB+2 ; 3182 BR 45$ ; 3174 44$: MOV R2,SCR.PB+26 ; BACKUP.PTR,* 3188 MOV R0,SCR.PB+24 ; 3189 BIS #2,SCR.PB+2 ; 3190 45$: MOV R4,R2 ; PTR,BACKUP.PTR 3196 MOVB (R4)+,R1 ; PTR,CHAR 3197 CMP R4,R3 ; PTR,END.PTR BHI 55$ CMP R1,#56 ; CHAR,* 3202 BEQ 47$ CMP R1,#73 ; CHAR,* 46$: BNE 55$ 47$: CLR R0 ; STATE 3212 48$: MOVB (R4)+,R1 ; PTR,CHAR 3220 CMP R4,R3 ; PTR,END.PTR BHI 53$ CMP R1,#60 ; CHAR,* 3225 BLO 50$ CMP R1,#71 ; CHAR,* BHI 50$ INC R0 ; STATE 3230 BNE 48$ 49$: BR 55$ 50$: CMP R1,#55 ; CHAR,* 3232 BNE 52$ TST R0 ; STATE 3239 51$: BNE 55$ INC R0 ; STATE 3241 BR 48$ ; 3222 52$: CMP R1,#52 ; CHAR,* 3244 BNE 53$ TST R0 ; STATE 3251 BNE 55$ COM R0 ; STATE 3253 BR 48$ ; 3222 53$: DEC R4 ; PTR 3266 TST R0 ; STATE 3272 BGE 54$ BIS #10,SCR.PB+2 54$: BIS #1,SCR.PB+2 ; 3274 MOV R2,SCR.PB+32 ; BACKUP.PTR,* 3275 MOV R4,SCR.PB+30 ; PTR,* 3276 SUB R2,SCR.PB+30 ; BACKUP.PTR,* MOV R4,R2 ; PTR,BACKUP.PTR 3277 55$: MOV R2,R4 ; BACKUP.PTR,PTR 3292 MOV R2,SCR.PB+36 ; BACKUP.PTR,* MOV R3,R5 ; END.PTR,LEN 3293 SUB R4,R5 ; PTR,LEN MOV R5,SCR.PB+34 ; LEN,* MOV SCR.PB+2,R0 ; 3295 BEQ 56$ BIT #-5,R0 BNE 56$ MOVB #1,SCR.PB+44 ; 3297 56$: MOV #1,SCR.PB ; 3299 TST (SP)+ ; 2518 RTS PC ; Routine Size: 341 words, Routine Base: $CODE$ + 7012 ; Maximum stack depth per invocation: 6 words .PSECT $PLIT$, RO , D P.AAB: ; CASE Table for FSS+0044 2624 2$: .WORD 160 ; [9$] .WORD -22 ; [1$] .WORD 160 ; [9$] .WORD -22 ; [1$] .WORD -22 ; [1$] .WORD 160 ; [9$] .WORD 44 ; [6$] .WORD 0 ; [3$] .WORD 160 ; [9$] .WORD 160 ; [9$] .WORD 160 ; [9$] .WORD 160 ; [9$] .WORD -22 ; [1$] .WORD -22 ; [1$] .WORD -22 ; [1$] .WORD 160 ; [9$] P.AAC: ; CASE Table for FSS+0250 2813 12$: .WORD 46 ; [14$] .WORD -20 ; [11$] .WORD 46 ; [14$] .WORD -20 ; [11$] .WORD -20 ; [11$] .WORD 46 ; [14$] .WORD 0 ; [13$] .WORD 46 ; [14$] .WORD 46 ; [14$] .WORD 46 ; [14$] .WORD 46 ; [14$] .WORD 46 ; [14$] .WORD -20 ; [11$] .WORD -20 ; [11$] .WORD -20 ; [11$] .WORD 46 ; [14$] P.AAD: ; CASE Table for FSS+0404 2932 19$: .WORD 52 ; [24$] .WORD -20 ; [18$] .WORD 52 ; [24$] .WORD -20 ; [18$] .WORD -20 ; [18$] .WORD 52 ; [24$] .WORD 52 ; [24$] .WORD 52 ; [24$] .WORD 46 ; [23$] .WORD 36 ; [22$] .WORD -20 ; [18$] .WORD 0 ; [20$] .WORD -20 ; [18$] .WORD -20 ; [18$] .WORD -20 ; [18$] .WORD 52 ; [24$] P.AAE: ; CASE Table for FSS+0502 3001 26$: .WORD 472 ; [55$] .WORD 472 ; [55$] .WORD 472 ; [55$] .WORD -20 ; [25$] .WORD 472 ; [55$] .WORD 10 ; [28$] .WORD 472 ; [55$] .WORD 472 ; [55$] .WORD 16 ; [29$] .WORD 0 ; [27$] .WORD 472 ; [55$] .WORD 472 ; [55$] .WORD 472 ; [55$] .WORD 472 ; [55$] .WORD -20 ; [25$] .WORD 472 ; [55$] P.AAF: ; CASE Table for FSS+0662 3116 37$: .WORD 66 ; [43$] .WORD -20 ; [36$] .WORD 66 ; [43$] .WORD -20 ; [36$] .WORD -20 ; [36$] .WORD 66 ; [43$] .WORD 66 ; [43$] .WORD 66 ; [43$] .WORD 66 ; [43$] .WORD 0 ; [38$] .WORD 66 ; [43$] .WORD 24 ; [41$] .WORD -20 ; [36$] .WORD -20 ; [36$] .WORD -20 ; [36$] .WORD 66 ; [43$] .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 3301 1 %SBTTL 'Classify character' ; 3302 1 GLOBAL_FOR_DEBUG ; 3303 1 ROUTINE ch$classify (char) : ch$classify_l = ; 3304 1 ; 3305 1 !++ ; 3306 1 ! ; 3307 1 ! FUNCTIONAL DESCRIPTION: ; 3308 1 ! ; 3309 1 ! Classify the character into one of the types of interest to ; 3310 1 ! the parseing routines. ; 3311 1 ! ; 3312 1 ! FORMAL PARAMETERS: ; 3313 1 ! ; 3314 1 ! char - Character to be classified. ; 3315 1 ! ; 3316 1 ! ROUTINE VALUE: ; 3317 1 ! COMPLETION CODES: ; 3318 1 ! ; 3319 1 ! The character classification is returned. ; 3320 1 ! ; 3321 1 !-- ; 3322 1 ; 3323 2 BEGIN ; 3324 2 ; 3325 2 LITERAL ; 3326 2 ctb = %C'"', ; 3327 2 cte = %C'z' + 1; ; 3328 2 ; 3329 2 OWN ; 3330 2 char_types : VECTOR [cte - ctb, BYTE, SIGNED] PRESET ( ; 3331 2 ! "alpha"s ; 3332 2 [%C'A'-ctb] = ch_alpha, ; 3333 2 [%C'B'-ctb] = ch_alpha, ; 3334 2 [%C'C'-ctb] = ch_alpha, ; 3335 2 [%C'D'-ctb] = ch_alpha, ; 3336 2 [%C'E'-ctb] = ch_alpha, ; 3337 2 [%C'F'-ctb] = ch_alpha, ; 3338 2 [%C'G'-ctb] = ch_alpha, ; 3339 2 [%C'H'-ctb] = ch_alpha, ; 3340 2 [%C'I'-ctb] = ch_alpha, ; 3341 2 [%C'J'-ctb] = ch_alpha, ; 3342 2 [%C'K'-ctb] = ch_alpha, ; 3343 2 [%C'L'-ctb] = ch_alpha, ; 3344 2 [%C'M'-ctb] = ch_alpha, ; 3345 2 [%C'N'-ctb] = ch_alpha, ; 3346 2 [%C'O'-ctb] = ch_alpha, ; 3347 2 [%C'P'-ctb] = ch_alpha, ; 3348 2 [%C'Q'-ctb] = ch_alpha, ; 3349 2 [%C'R'-ctb] = ch_alpha, ; 3350 2 [%C'S'-ctb] = ch_alpha, ; 3351 2 [%C'T'-ctb] = ch_alpha, ; 3352 2 [%C'U'-ctb] = ch_alpha, ; 3353 2 [%C'V'-ctb] = ch_alpha, ; 3354 2 [%C'W'-ctb] = ch_alpha, ; 3355 2 [%C'X'-ctb] = ch_alpha, ; 3356 2 [%C'Y'-ctb] = ch_alpha, ; 3357 2 [%C'Z'-ctb] = ch_alpha, ; 3358 2 ; 3359 2 [%C'a'-ctb] = ch_lower, ; 3360 2 [%C'b'-ctb] = ch_lower, ; 3361 2 [%C'c'-ctb] = ch_lower, ; 3362 2 [%C'd'-ctb] = ch_lower, ; 3363 2 [%C'e'-ctb] = ch_lower, ; 3364 2 [%C'f'-ctb] = ch_lower, ; 3365 2 [%C'g'-ctb] = ch_lower, ; 3366 2 [%C'h'-ctb] = ch_lower, ; 3367 2 [%C'i'-ctb] = ch_lower, ; 3368 2 [%C'j'-ctb] = ch_lower, ; 3369 2 [%C'k'-ctb] = ch_lower, ; 3370 2 [%C'l'-ctb] = ch_lower, ; 3371 2 [%C'm'-ctb] = ch_lower, ; 3372 2 [%C'n'-ctb] = ch_lower, ; 3373 2 [%C'o'-ctb] = ch_lower, ; 3374 2 [%C'p'-ctb] = ch_lower, ; 3375 2 [%C'q'-ctb] = ch_lower, ; 3376 2 [%C'r'-ctb] = ch_lower, ; 3377 2 [%C's'-ctb] = ch_lower, ; 3378 2 [%C't'-ctb] = ch_lower, ; 3379 2 [%C'u'-ctb] = ch_lower, ; 3380 2 [%C'v'-ctb] = ch_lower, ; 3381 2 [%C'w'-ctb] = ch_lower, ; 3382 2 [%C'x'-ctb] = ch_lower, ; 3383 2 [%C'y'-ctb] = ch_lower, ; 3384 2 [%C'z'-ctb] = ch_lower, ; 3385 2 ! numbers ; 3386 2 [%C'0'-ctb] = ch_oct, ; 3387 2 [%C'1'-ctb] = ch_oct, ; 3388 2 [%C'2'-ctb] = ch_oct, ; 3389 2 [%C'3'-ctb] = ch_oct, ; 3390 2 [%C'4'-ctb] = ch_oct, ; 3391 2 [%C'5'-ctb] = ch_oct, ; 3392 2 [%C'6'-ctb] = ch_oct, ; 3393 2 [%C'7'-ctb] = ch_oct, ; 3394 2 [%C'8'-ctb] = ch_8and9, ; 3395 2 [%C'9'-ctb] = ch_8and9, ; 3396 2 ! special characters ; 3397 2 [%C'$'-ctb] = ch_dollar, ; 3398 2 [%C'_'-ctb] = ch_under, ; 3399 2 [%C'.'-ctb] = ch_dot, ; 3400 2 [%C','-ctb] = ch_comma, ; 3401 2 [%C':'-ctb] = ch_colon, ; 3402 2 [%C'-'-ctb] = ch_dash, ; 3403 2 [%C'"'-ctb] = ch_quote, ; 3404 2 [%C'*'-ctb] = ch_wild, ; 3405 2 [%C'%'-ctb] = ch_wild, ; 3406 2 [%C';'-ctb] = ch_misc, ; 3407 2 [%C'['-ctb] = ch_misc, ; 3408 2 [%C']'-ctb] = ch_dir, ; 3409 2 [%C'<'-ctb] = ch_misc, ; 3410 2 [%C'>'-ctb] = ch_dir ); ; 3411 2 ; 3412 2 BUILTIN ; 3413 2 R0; ; 3414 2 ; 3415 2 R0 = .char - ctb; ; 3416 2 ; 3417 2 IF .R0 GEQU cte - ctb ; 3418 2 THEN ; 3419 3 BEGIN ; 3420 3 ; 3421 3 SELECTONE .char OF ; 3422 3 SET ; 3423 3 ; 3424 3 [0, 9, %C' '] : ; 3425 3 RETURN ch_space; ; 3426 3 ; 3427 3 [OTHERWISE] : ; 3428 3 RETURN ch_other; ; 3429 3 TES; ; 3430 3 ; 3431 2 END; ; 3432 2 ; 3433 2 RETURN .char_types [.R0]; ; 3434 1 END; .NLIST .LIST BIN,LOC .LIST .PSECT $OWN$, D CHAR.TYPES: .BYTE 7 .BYTE 0 .BYTE 14 .BYTE 11 .BYTE 0 .BYTE 0 .BYTE 0 .BYTE 0 .BYTE 11 .BYTE 0 .BYTE 5 .BYTE 12 .BYTE 13 .BYTE 0 .BYTE 3 .BYTE 3 .BYTE 3 .BYTE 3 .BYTE 3 .BYTE 3 .BYTE 3 .BYTE 3 .BYTE 16 .BYTE 16 .BYTE 6 .BYTE 17 .BYTE 17 .BYTE 0 .BYTE 10 .BYTE 0 .BYTE 0 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 4 .BYTE 17 .BYTE 0 .BYTE 10 .BYTE 0 .BYTE 15 .BYTE 0 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .BYTE 1 .SBTTL CH$CLASSIFY Classify character .PSECT $CODE$, RO .NLIST .ENABL LSB .LIST CH$CLASSIFY: MOV R1,-(SP) ; 3303 MOV R1,R0 ; CHAR,R0 3415 SUB #42,R0 ; *,R0 CMP R0,#131 ; R0,* 3417 BLO 4$ TST R1 ; CHAR 3424 BEQ 1$ CMP R1,#11 ; CHAR,* BEQ 1$ CMP R1,#40 ; CHAR,* BNE 2$ 1$: MOV #2,R1 ; 3421 BR 3$ 2$: CLR R1 3$: MOV R1,R0 ; 3419 BR 5$ 4$: MOVB CHAR.TYPES(R0),R0 ; *(R0),* 3433 5$: MOV (SP)+,R1 ; 3303 RTS PC ; Routine Size: 25 words, Routine Base: $CODE$ + 10264 ; Maximum stack depth per invocation: 2 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 3435 1 %SBTTL 'Copy, upcase, and compress a string and return a status' ; 3436 1 GLOBAL_FOR_DEBUG ; 3437 1 ROUTINE ch$copy (len, in_ptr, out_ptr_p; out_ptr) : ch$copy_l NOVALUE= ; 3438 1 ; 3439 1 !++ ; 3440 1 ! ; 3441 1 ! FUNCTIONAL DESCRIPTION: ; 3442 1 ! ; 3443 1 ! The input string is copyed to the output string. During the ; 3444 1 ! copy operation it is upcased and compressed. ; 3445 1 ! ; 3446 1 ! FORMAL PARAMETERS: ; 3447 1 ! ; 3448 1 ! len - Length of the input string ; 3449 1 ! in_ptr - Input buffer pointer ; 3450 1 ! out_ptr_p - Output buffer pointer ; 3451 1 ! ; 3452 1 ! out_ptr - Points to end of string in the output buffer ; 3453 1 ! ; 3454 1 !-- ; 3455 1 ; 3456 2 BEGIN ; 3457 2 ; 3458 2 MAP ; 3459 2 in_ptr : REF VECTOR [, BYTE, SIGNED], ; 3460 2 out_ptr : REF VECTOR [, BYTE, SIGNED]; ; 3461 2 ; 3462 2 LOCAL ; 3463 2 state, ! Quote state, zero is unquoted ; 3464 2 char; ; 3465 2 ; 3466 2 out_ptr = .out_ptr_p; ! Discard the input parameter now ; 3467 2 state = 0; ! Quote state to unquoted ; 3468 2 ; 3469 2 INCRU i FROM 0 TO .len - 1 DO ; 3470 3 BEGIN ; 3471 3 char = .in_ptr [.i]; ; 3472 3 ; 3473 3 IF .state EQLU 0 ; 3474 3 THEN ; 3475 4 BEGIN ; 3476 4 ; 3477 4 CASE ch$classify (.char) FROM 0 TO ch_max OF ; 3478 4 SET ; 3479 4 ; 3480 4 [ch_other] : ; 3481 4 ; 3482 4 ! ; 3483 4 ! Characters other than the valid set that aren't ; 3484 4 ! quoted won't be upcased. ; 3485 4 ! ; 3486 5 BEGIN ; 3487 5 out_ptr [0] = .char; ; 3488 5 out_ptr = out_ptr [1]; ; 3489 4 END; ; 3490 4 ; 3491 4 [ch_quote] : ; 3492 5 BEGIN ; 3493 5 ; 3494 5 ! ; 3495 5 ! If quote, change the state and output character ; 3496 5 ! ; 3497 5 state = NOT .state; ; 3498 5 out_ptr [0] = .char; ; 3499 5 out_ptr = out_ptr [1]; ; 3500 4 END; ; 3501 4 ; 3502 4 [ch_lower] : ; 3503 4 ; 3504 4 ! ; 3505 4 ! Upcase lowercase letters ; 3506 4 ! ; 3507 5 BEGIN ; 3508 5 char = .char AND NOT %O'40'; ; 3509 5 out_ptr [0] = .char; ; 3510 5 out_ptr = out_ptr [1]; ; 3511 4 END; ; 3512 4 ; 3513 4 [ch_space] : ; 3514 4 ; 3515 4 ! ; 3516 4 ! Remove spaces ; 3517 4 ! ; 3518 4 ; ; 3519 4 ; 3520 4 [INRANGE] : ; 3521 4 ; 3522 4 ! ; 3523 4 ! Output valid characters ; 3524 4 ! ; 3525 5 BEGIN ; 3526 5 out_ptr [0] = .char; ; 3527 5 out_ptr = out_ptr [1]; ; 3528 4 END; ; 3529 4 TES; ; 3530 4 ; 3531 4 END ; 3532 3 ELSE ; 3533 4 BEGIN ; 3534 4 ; 3535 4 ! ; 3536 4 ! If quoted, output it no matter what ; 3537 4 ! ; 3538 4 IF .char EQLU %C'"' THEN state = NOT .state; ; 3539 4 ; 3540 4 out_ptr [0] = .char; ; 3541 4 out_ptr = out_ptr [1]; ; 3542 3 END; ; 3543 3 ; 3544 2 END; ; 3545 2 ; 3546 2 ! ; 3547 2 ! Allow unbalanced quoted strings if there is room. ; 3548 2 ! ; 3549 2 IF .state NEQU 0 ; 3550 2 THEN ; 3551 2 IF (.len + 1) LEQU file_spec_size ; 3552 2 THEN ; 3553 3 BEGIN ; 3554 3 out_ptr [0] = %C'"'; ; 3555 3 out_ptr = out_ptr [1]; ; 3556 2 END; ; 3557 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL CH$COPY Copy, upcase, and compress a string and return .NLIST .ENABL LSB .LIST CH$COPY:MOV R4,-(SP) ; 3437 MOV R5,-(SP) TST -(SP) MOV R2,-(SP) MOV R1,2(SP) CLR R5 ; STATE 3467 MOV R1,-(SP) ; 3469 DEC (SP) CLR R4 ; I BR 8$ 1$: MOV R4,R2 ; I,* 3471 ADD 2(SP),R2 MOVB (R2),R1 ; *,CHAR TST R5 ; STATE 3473 BNE 4$ JSR PC,CH$CLASSIFY ; 3477 ASL R0 ADD P.AAG(R0),PC ; Case dispatch 3$: BIC #40,R1 ; *,CHAR 3508 BR 6$ ; 3509 4$: CMP R1,#42 ; CHAR,* 3538 BNE 6$ 5$: COM R5 ; STATE 6$: MOVB R1,(R3)+ ; CHAR,OUT.PTR 3540 7$: INC R4 ; I 3469 8$: CMP R4,(SP) ; I,* BLOS 1$ TST R5 ; STATE 3549 BEQ 9$ MOV 4(SP),R1 ; 3551 INC R1 CMP R1,#377 BHI 9$ MOVB #42,(R3)+ ; *,OUT.PTR 3554 9$: ADD #6,SP ; 3437 MOV (SP)+,R5 MOV (SP)+,R4 RTS PC ; Routine Size: 48 words, Routine Base: $CODE$ + 10346 ; Maximum stack depth per invocation: 7 words .PSECT $PLIT$, RO , D P.AAG: ; CASE Table for CH$COPY+0050 3477 2$: .WORD 16 ; [6$] .WORD 0 ; [3$] .WORD 20 ; [7$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 14 ; [5$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 16 ; [6$] .WORD 16 ; [6$] .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 3558 1 %SBTTL 'Convert parse block from kernel virtual to user virtual' ; 3559 1 GLOBAL_FOR_DEBUG ; 3560 1 ROUTINE convert_parse (parse_block, k_virtual, u_virtual) : NOVALUE = ; 3561 1 ; 3562 1 !++ ; 3563 1 ! ; 3564 1 ! FUNCTIONAL DESCRIPTION: ; 3565 1 ! ; 3566 1 ! Convert parse block address fields from kernel virtual ; 3567 1 ! to user virtual. ; 3568 1 ! ; 3569 1 ! FORMAL PARAMETERS: ; 3570 1 ! ; 3571 1 ! parse_block - Address of the parse block ; 3572 1 ! k_virtual - Address of string in executive buffer ; 3573 1 ! u_virtual - Address of corresponding string in user buffer ; 3574 1 ! ; 3575 1 !-- ; 3576 1 ; 3577 2 BEGIN ; 3578 2 ; 3579 2 MAP ; 3580 2 parse_block : REF BLOCK FIELD (parse_block_f); ; 3581 2 ; 3582 2 LOCAL ; 3583 2 p : REF VECTOR; ; 3584 2 ; 3585 2 p = parse_block [node_addr]; ; 3586 2 ; 3587 2 WHILE .p LEQA parse_block [access_addr] DO ; 3588 3 BEGIN ; 3589 3 ; 3590 3 IF .p [0] NEQU 0 THEN p [0] = .p [0] - .k_virtual + .u_virtual; ; 3591 3 ; 3592 3 p = p [2]; ; 3593 2 END; ; 3594 2 ; 3595 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL CONVERT.PARSE Convert parse block from kernel virtual to user .PSECT $CODE$, RO .NLIST .ENABL LSB .LIST CONVERT.PARSE: JSR R1,$SAVE2 ; 3560 MOV 14(SP),R1 ; PARSE.BLOCK,P 3585 ADD #6,R1 ; *,P MOV 14(SP),R2 ; PARSE.BLOCK,* 3587 ADD #42,R2 1$: CMP R1,R2 ; P,* BHI 3$ TST (R1) ; P 3590 BEQ 2$ MOV (R1),R0 ; P,* SUB 12(SP),R0 ; K.VIRTUAL,* ADD 10(SP),R0 ; U.VIRTUAL,* MOV R0,(R1) ; *,P 2$: ADD #4,R1 ; *,P 3592 BR 1$ ; 3587 3$: RTS PC ; 3560 ; Routine Size: 24 words, Routine Base: $CODE$ + 10506 ; Maximum stack depth per invocation: 4 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 3596 1 %SBTTL 'Save parse block and zero it' ; 3597 1 GLOBAL_FOR_DEBUG ; 3598 1 ROUTINE save_parse (out_ptr) : save_parse_l NOVALUE = ; 3599 1 ; 3600 1 !++ ; 3601 1 ! ; 3602 1 ! FUNCTIONAL DESCRIPTION: ; 3603 1 ! ; 3604 1 ! Copy the parse block to a specified save area and then zero it. ; 3605 1 ! The operation is done in such a manner that it can be zeroed by ; 3606 1 ! specifying the output as the scr_pb. ; 3607 1 ! ; 3608 1 ! FORMAL PARAMETERS: ; 3609 1 ! ; 3610 1 ! out_ptr - Address of the output parse block ; 3611 1 ! ; 3612 1 ! IMPLICIT OUTPUTS: ; 3613 1 ! ; 3614 1 ! Scratch parse block. ; 3615 1 ! ; 3616 1 !-- ; 3617 1 ; 3618 2 BEGIN ; 3619 2 ; 3620 2 LOCAL ; 3621 2 in_ptr : REF VECTOR; ; 3622 2 ; 3623 2 MAP ; 3624 2 out_ptr : REF VECTOR; ; 3625 2 ; 3626 2 in_ptr = scr_pb; ; 3627 2 ; 3628 2 DECR i FROM parse_block_size TO 1 DO ; 3629 3 BEGIN ; 3630 3 out_ptr [0] = .in_ptr [0]; ; 3631 3 out_ptr = out_ptr [1]; ; 3632 3 in_ptr [0] = 0; ; 3633 3 in_ptr = in_ptr [1]; ; 3634 2 END; ; 3635 2 ; 3636 1 END; .NLIST .LIST BIN,LOC .LIST .SBTTL SAVE.PARSE Save parse block and zero it .NLIST .ENABL LSB .LIST SAVE.PARSE: MOV #SCR.PB,R2 ; *,IN.PTR 3626 MOV #23,R0 ; *,I 3628 1$: MOV (R2),(R1)+ ; IN.PTR,OUT.PTR 3630 CLR (R2)+ ; IN.PTR 3632 SOB R0,1$ ; I,* 3628 RTS PC ; 3598 ; Routine Size: 8 words, Routine Base: $CODE$ + 10566 ; Maximum stack depth per invocation: 0 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 3637 1 %SBTTL 'Find Equivalence String' ; 3638 1 ROUTINE find_something (logical_addr, logical_len ; equiv_addr, equiv_len) : find_equivalence_l = ; 3639 1 ; 3640 1 !++ ; 3641 1 ! ; 3642 1 ! FUNCTIONAL DESCRIPTION: ; 3643 1 ! ; 3644 1 ! Find the equivalence string for the input logical name. Return ; 3645 1 ! status. If the input logical name starts with an '_' then return the ; 3646 1 ! string less the '_' and the status of terminal. ; 3647 1 ! ; 3648 1 ! FORMAL PARAMETERS: ; 3649 1 ! ; 3650 1 ! logical_addr - Address of the logical name ; 3651 1 ! logical_len - Length of the logical name in bytes ; 3652 1 ! ; 3653 1 ! equiv_addr - Address of the equivalence string ; 3654 1 ! equiv_len - Length of the equivalence string ; 3655 1 ! ; 3656 1 ! ROUTINE VALUE: ; 3657 1 ! ; 3658 1 ! success, terminal, or error ; 3659 1 ! ; 3660 1 !-- ; 3661 1 ; 3662 2 BEGIN ; 3663 2 ; 3664 2 ! ; 3665 2 ! Define the LNB fields used in this routine. ; 3666 2 ! ; 3667 2 FIELD ; 3668 2 lnb_f = ; 3669 2 SET ; 3670 2 logical_link = [0, 0, 16, 0], ! Link to the next lnb ; 3671 2 logical_table = [1, 0, 8, 0], ! Logical table number ; 3672 2 logical_type = [1, 8, 8, 0], ! Logical name block type ; 3673 2 logical_status = [2, 0, 8, 0], ! Logical name status ; 3674 2 terminal_logical = [2, 0, 1, 0],! Set for terminal logical ; 3675 2 creator_group_number = [2, 8, 8, 0], ! Creator group number ; 3676 2 creator_ucb = [3, 0, 16, 0], ! Creator UCB (user) ; 3677 2 creator_tcb = [3, 0, 16, 0], ! Creator TCB (task) ; 3678 2 logical_length = [4, 0, 8, 0], ! Logical name length in bytes ; 3679 2 equivalence_length = [4, 8, 8, 0], ! 32 word block offset of base ; 3680 2 logical_name_start = [5, 0, 16, 0] ! Start of logical name ; 3681 2 TES; ; 3682 2 ; 3683 2 LITERAL ; 3684 2 lnb_size = 5; ! Size of the fixed part of the ; 3685 2 ! LNB in words ; 3686 2 ; 3687 2 LOCAL ; 3688 2 logical_descriptor : BLOCK [logical_descriptor_size] ; 3689 2 FIELD (logical_descriptor_f), ! Logical name descriptor block ; 3690 2 lnb_base, ! Base physical address of LNB ; 3691 2 lookup_len; ! The length that we actually look up ; 3692 2 ; 3693 2 OWN ; 3694 2 log_buf : VECTOR [ logical_size, BYTE]; ; 3695 2 ; 3696 2 BIND ; 3697 2 lnb = apr6_v : BLOCK [lnb_size] FIELD (lnb_f); ! Logical name descriptor block address ; 3698 2 ; 3699 2 LABEL ; 3700 2 zero_compress; ; 3701 2 ! ; 3702 2 ! Check for an underscore. If there is one return the logical ; 3703 2 ! name less the underscore as the equivalence string along with ; 3704 2 ! the status of terminal. ; 3705 2 ! ; 3706 2 IF .logical_len GEQU 1 ; 3707 2 THEN ; 3708 3 BEGIN ; 3709 3 IF .(.logical_addr)<0,8> EQLU %C'_' ; 3710 3 THEN IF .logical_len EQLU 1 !PKW111 ; 3711 3 THEN RETURN error !PKW111 ; 3712 3 ELSE !PKW111 ; 3713 4 BEGIN ; 3714 4 equiv_addr = .logical_addr + 1; ; 3715 4 equiv_len = .logical_len - 1; ; 3716 4 RETURN terminal; ; 3717 3 END; ; 3718 3 ; 3719 3 ! Unfortunately it is possible to call this routine ; 3720 3 ! specifying that a lun is not to be assigned. That ; 3721 3 ! means that the zero compression method of assigning ; 3722 3 ! the lun and then doing a GLUN won't always work. ; 3723 3 ! So we have to do the zero compression by hand. GACK. ; 3724 3 ! We also need to strip off any colons before we do the ; 3725 3 ! lookup. Note that zero compression is only done if there ; 3726 3 ! is exactly one colon on the end of the logical. ; 3727 3 ; 3728 3 ch$copy (.logical_len, .logical_addr, log_buf [0]; lookup_len); ; 3729 3 lookup_len = .lookup_len - log_buf [0]; ; 3730 3 IF .log_buf [.lookup_len - 1] EQLU %C':' ; 3731 3 THEN ; 3732 4 BEGIN ; 3733 4 lookup_len = .lookup_len - 1; ; 3734 4 IF .log_buf [.lookup_len - 1] EQLU %C':' ! If two colons it's a node ; 3735 4 THEN lookup_len = .lookup_len - 1 ; 3736 4 ELSE ; 3737 4 zero_compress: ; 3738 5 BEGIN ; 3739 5 MACRO ; 3740 5 ! ; 3741 5 ! NEXT_CHAR gets the next character and returns true if success ; 3742 5 ! ; M 3743 5 next_char = ; M 3744 5 BEGIN ; M 3745 5 char = .(.ptr)<0, 8, 1>; ; M 3746 5 ptr = .ptr + 1; ; M 3747 5 .ptr LEQA .end_ptr ; 3748 5 END %; ; 3749 5 ; 3750 5 REGISTER ; 3751 5 char; ; 3752 5 ; 3753 5 LOCAL ; 3754 5 ptr, ; 3755 5 end_ptr, ; 3756 5 zero_count, ; 3757 5 status, ; 3758 5 i; ; 3759 5 ; 3760 5 ptr = log_buf [0]; ! Start of scan ; 3761 5 end_ptr = .ptr + .lookup_len; ; 3762 5 ; 3763 5 IF NOT next_char THEN LEAVE zero_compress; ! The first two characters must be letters ; 3764 5 status = ch$classify (.char); ; 3765 6 IF (.status NEQU ch_alpha) AND (.status NEQU ch_lower) ; 3766 5 THEN LEAVE zero_compress; ; 3767 5 IF NOT next_char THEN LEAVE zero_compress; ! The first two characters must be letters ; 3768 5 status = ch$classify (.char); ; 3769 6 IF (.status NEQU ch_alpha) AND (.status NEQU ch_lower) ; 3770 5 THEN LEAVE zero_compress; ; 3771 5 zero_count = 0; ; 3772 5 WHILE next_char DO ! Now look for zeros ; 3773 5 IF .char EQLU %C'0' ; 3774 5 THEN zero_count = .zero_count+1 ; 3775 5 ELSE EXITLOOP; ; 3776 5 IF .zero_count EQLU 0 THEN LEAVE zero_compress; ! If none, then leave. ; 3777 5 IF .ptr GTRU .end_ptr THEN ! If no following characters, ; 3778 6 BEGIN ! Then just lop off the zeros ; 3779 6 lookup_len = .lookup_len - .zero_count; ; 3780 6 LEAVE zero_compress; ; 3781 5 END; ; 3782 5 DO ! Now look for octal digits ; 3783 5 IF ch$classify (.char) NEQU ch_oct ; 3784 5 THEN LEAVE zero_compress ! Anything else, exit ; 3785 5 WHILE next_char; ; 3786 5 ptr = log_buf [2]; ! Now chop out the zeros ; 3787 5 end_ptr = log_buf [2] + .zero_count; ; 3788 5 lookup_len = .lookup_len - .zero_count; ; 3789 5 DECR i FROM (.lookup_len - 2) TO 0 DO ; 3790 6 BEGIN ; 3791 6 (.ptr)<0, 8, 1> = .(.end_ptr)<0, 8, 1>; ; 3792 6 ptr = .ptr + 1; ; 3793 6 end_ptr = .end_ptr + 1; ; 3794 5 END; ; 3795 4 END; ; 3796 3 END; ; 3797 3 ; 3798 3 ! ; 3799 3 ! Settup the input logical name length and address ; 3800 3 ! in the logical descriptor block. Then attempt to ; 3801 3 ! do the translation. The block_type, table_number, ; 3802 3 ! address_base, matching_tcb_ucb fields and $TONYL were ; 3803 3 ! settup during initialization. ; 3804 3 ! ; 3805 3 ; 3806 3 logical_descriptor [length] = .lookup_len; ; 3807 3 logical_descriptor [address_disp_apr6] = log_buf [0] + (apr6_v - apr5_v); ; 3808 3 $TONYL = .saved_inhibit_mask; ! Settup the inhibit mask ; 3809 3 logical_descriptor [block_type] = .init_logical_descriptor [block_type]; ; 3810 3 logical_descriptor [table_number] = .init_logical_descriptor [table_number]; ; 3811 3 logical_descriptor [address_base] = .init_logical_descriptor [address_base]; ; 3812 3 logical_descriptor [matching_tcb_ucb] = .init_logical_descriptor [matching_tcb_ucb]; ; 3813 3 ; 3814 3 IF TBSRC_BLI (logical_descriptor; lnb_base) THEN RETURN error; ; 3815 3 ; 3816 3 KISAR6 = .lnb_base; ! Map the logical name block ; 3817 3 equiv_len = .lnb [equivalence_length]; ! Return the length ; 3818 3 ; 3819 3 ! ; 3820 3 ! The equivalence string follows the logical name string in the lnb ; 3821 3 ! ; 3822 3 equiv_addr = lnb [logical_name_start] + .lnb [logical_length]; ; 3823 3 ; 3824 3 ! ; 3825 3 ! Return terminal if it is. ; 3826 3 ! ; 3827 3 RETURN IF .lnb [terminal_logical] THEN terminal ELSE success; ; 3828 3 ; 3829 3 END ; 3830 2 ELSE ; 3831 2 RETURN error; ! No logical comming in ; 3832 1 END; ! End of routine find_equivalence .NLIST .LIST BIN,LOC .LIST .PSECT $OWN$, D .EVEN LOG.BUF:.BLKB 377 LNB= -40000 .SBTTL FIND.EQUIVALENCE Find Equivalence String .PSECT $CODE$, RO .NLIST .ENABL LSB .LIST FIND.EQUIVALENCE: MOV R3,-(SP) ; 3638 MOV R4,-(SP) MOV R5,-(SP) SUB #16,SP MOV R2,R4 ; *,LOGICAL.LEN MOV R1,R0 ; *,LOGICAL.ADDR TST R4 ; LOGICAL.LEN 3706 BNE 1$ JMP 15$ 1$: CMPB (R0),#137 ; LOGICAL.ADDR,* 3709 BNE 4$ CMP R4,#1 ; LOGICAL.LEN,* 3710 BNE 2$ CLR R1 ; 3713 BR 3$ 2$: MOV #1,(SP) ; *,EQUIV.ADDR 3714 ADD R0,(SP) ; LOGICAL.ADDR,EQUIV.ADDR MOV R4,2(SP) ; LOGICAL.LEN,EQUIV.LEN 3715 DEC 2(SP) ; EQUIV.LEN MOV #3,R1 ; 3713 3$: MOV R1,R0 ; 3710 BR 14$ 4$: MOV R4,R1 ; LOGICAL.LEN,* 3728 MOV R0,R2 ; LOGICAL.ADDR,* MOV #LOG.BUF,R3 JSR PC,CH$COPY SUB #LOG.BUF,R3 ; *,LOOKUP.LEN 3729 CMPB LOG.BUF-1(R3),#72 ; *(LOOKUP.LEN),* 3730 BNE 12$ DEC R3 ; LOOKUP.LEN 3733 CMPB LOG.BUF-1(R3),#72 ; *(LOOKUP.LEN),* 3734 BNE 5$ DEC R3 ; LOOKUP.LEN 3735 BR 12$ ; 3734 5$: MOV #LOG.BUF,R2 ; *,PTR 3760 MOV R3,R5 ; LOOKUP.LEN,END.PTR 3761 ADD R2,R5 ; PTR,END.PTR MOVB (R2)+,R1 ; PTR,CHAR 3763 CMP R2,R5 ; PTR,END.PTR BHI 12$ JSR PC,CH$CLASSIFY ; 3764 CMP R0,#4 ; STATUS,* 3765 BEQ 6$ CMP R0,#1 ; STATUS,* BNE 12$ ; 3766 6$: MOVB (R2)+,R1 ; PTR,CHAR 3767 CMP R2,R5 ; PTR,END.PTR BHI 12$ JSR PC,CH$CLASSIFY ; 3768 CMP R0,#4 ; STATUS,* 3769 BEQ 7$ CMP R0,#1 ; STATUS,* BNE 12$ ; 3770 7$: CLR R4 ; ZERO.COUNT 3771 8$: MOVB (R2)+,R1 ; PTR,CHAR 3772 CMP R2,R5 ; PTR,END.PTR BHI 9$ CMP R1,#60 ; CHAR,* 3773 BNE 9$ INC R4 ; ZERO.COUNT 3774 BR 8$ ; 3773 9$: TST R4 ; ZERO.COUNT 3776 BEQ 12$ CMP R2,R5 ; PTR,END.PTR 3777 BLOS 10$ SUB R4,R3 ; ZERO.COUNT,LOOKUP.LEN 3779 BR 12$ ; 3778 10$: JSR PC,CH$CLASSIFY ; 3783 CMP R0,#3 BNE 12$ ; 3784 MOVB (R2)+,R1 ; PTR,CHAR 3785 CMP R2,R5 ; PTR,END.PTR BLOS 10$ MOV #LOG.BUF+2,R2 ; *,PTR 3786 MOV R4,R5 ; ZERO.COUNT,END.PTR 3787 ADD R2,R5 ; LOG.BUF+2,END.PTR SUB R4,R3 ; ZERO.COUNT,LOOKUP.LEN 3788 MOV R3,R0 ; LOOKUP.LEN,I 3789 SUB #2,R0 ; *,I BLT 12$ 11$: MOVB (R5)+,(R2)+ ; END.PTR,PTR 3791 DEC R0 ; I 3789 BGE 11$ 12$: MOV R3,4(SP) ; LOOKUP.LEN,LOGICAL.DESCRIP 3806 MOV #LOG.BUF+20000,10(SP) ; *,LOGICAL.DESCRIP+4 3807 MOV SAVED.INHIBIT.MASK,$TONYL ; 3808 MOVB INIT.LOGICAL.DESCRIPTOR+7,13(SP); *,LOGICAL.DESCRIP+6 3809 MOVB INIT.LOGICAL.DESCRIPTOR+6,12(SP); *,LOGICAL.DESCRIP+6 3810 MOV INIT.LOGICAL.DESCRIPTOR+2,6(SP) ; *,LOGICAL.DESCRIP+2 3811 MOV INIT.LOGICAL.DESCRIPTOR+10,14(SP) ; ; *,LOGICAL.DESCRIP+10 3812 MOV #4,R0 ; 3814 ADD SP,R0 ; LOGICAL.DESCRIP,* JSR PC,TBSRC.BLI BLO 15$ MOV R3,KISAR6 ; LNB.BASE,* 3816 CLR 2(SP) ; EQUIV.LEN 3817 MOVB @#140011,2(SP) ; *,EQUIV.LEN CLR (SP) ; EQUIV.ADDR 3822 MOVB @#140010,(SP) ; *,EQUIV.ADDR SUB #37766,(SP) ; *,EQUIV.ADDR BIT #1,@#140004 ; 3827 BEQ 13$ MOV #3,R0 BR 16$ 13$: MOV #1,R0 14$: BR 16$ ; 3831 15$: CLR R0 ; 3638 16$: MOV 2(SP),R2 ; EQUIV.LEN,* MOV (SP)+,R1 ; EQUIV.ADDR,* ADD #14,SP MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 RTS PC ; Routine Size: 168 words, Routine Base: $CODE$ + 10606 ; Maximum stack depth per invocation: 13 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 3833 1 %SBTTL 'Convert RAD50 to ASCII' ; 3834 1 ROUTINE RAD50_to_ASCII (ascii_len, ascii_addr, rad50_addr; return_ascii_addr) : RAD50_to_ASCII_l NOVALUE = ; 3835 1 ; 3836 1 !++ ; 3837 1 ! ; 3838 1 ! FUNCTIONAL DESCRIPTION: ; 3839 1 ! ; 3840 1 ! Convert a RAD50 string to ASCII. Trailing blanks suppressed. ; 3841 1 ! ; 3842 1 !-- ; 3843 2 BEGIN ; 3844 2 MAP ; 3845 2 ascii_addr : REF VECTOR [,BYTE], ; 3846 2 return_ascii_addr : REF VECTOR [,BYTE], ; 3847 2 rad50_addr : REF VECTOR; ; 3848 2 ; 3849 2 LOCAL ; 3850 2 t : VECTOR [2], ! Temporary for divide ; 3851 2 char, ; 3852 2 control; ; 3853 2 ; 3854 2 return_ascii_addr = ascii_addr [0]; ; 3855 2 ; 3856 2 ! ; 3857 2 ! Move the string to output buffer. ; 3858 2 ! ; 3859 2 control = 0; ! Initialize control ; 3860 2 ; 3861 2 DECR i FROM .ascii_len TO 1 DO ; 3862 3 BEGIN ; 3863 3 BUILTIN ; 3864 3 EDIV; ; 3865 3 ; 3866 3 IF .control EQL 0 ; 3867 3 THEN ; 3868 4 BEGIN ; 3869 4 t [1] = 0; ; 3870 4 t [0] = .rad50_addr [0]; ; 3871 4 rad50_addr = rad50_addr [1]; ; 3872 4 control = 40*40; ; 3873 3 END; ; 3874 3 ; 3875 3 IF .t [0] GTRU (39*40 + 39)*40 + 39 ; 3876 3 THEN ; 3877 3 char = '?' ; 3878 3 ELSE ; 3879 4 BEGIN ; 3880 4 EDIV (control, t, char, t [0]); ; 3881 4 ; 3882 4 SELECTONEU .char OF ; 3883 4 SET ; 3884 4 ; 3885 4 [0] : ; 3886 4 EXITLOOP; ; 3887 4 ; 3888 4 [1 TO 26] : ; 3889 4 char = .char + %C'A' - 1; ; 3890 4 ; 3891 4 [27] : ; 3892 4 char = .char + %C'$' - 27; ; 3893 4 ; 3894 4 [28] : ; 3895 4 char = .char + %C'.' - 28; ; 3896 4 ; 3897 4 [29] : ; 3898 4 char = .char + %C'?' - 29; ; 3899 4 ; 3900 4 [OTHERWISE] : ; 3901 4 char = .char + %C'0' - 30; ; 3902 4 TES; ; 3903 3 END; ; 3904 3 ; 3905 3 return_ascii_addr [0] = .char; ; 3906 3 return_ascii_addr = return_ascii_addr [1]; ; 3907 3 control = .control/40; ; 3908 2 END; ! DECR ; 3909 2 ; 3910 1 END; ! RAD50_to_ASCII .NLIST .LIST BIN,LOC .LIST .SBTTL RAD50.TO.ASCII Convert RAD50 to ASCII .NLIST .ENABL LSB .LIST RAD50.TO.ASCII: MOV R1,-(SP) ; 3834 MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) CMP -(SP),-(SP) CLR R5 ; CONTROL 3859 MOV R1,-(SP) ; ASCII.LEN,I 3861 BLE 8$ 1$: TST R5 ; CONTROL 3866 BNE 2$ CLR 4(SP) ; T+2 3869 MOV (R3)+,2(SP) ; RAD50.ADDR,T 3870 MOV #3100,R5 ; *,CONTROL 3872 2$: CMP 2(SP),#174777 ; T,* 3875 BLOS 3$ MOV #77,R4 ; *,CHAR 3877 BR 7$ ; 3875 3$: MOV 2(SP),R1 ; T,* 3880 MOV 4(SP),R0 ; T,* DIV R5,R0 ; CONTROL,* MOV R0,R4 ; *,CHAR MOV R1,2(SP) ; *,T TST R4 ; CHAR 3885 BEQ 8$ ; 3886 CMP R4,#32 ; CHAR,* 3888 BHI 4$ ADD #100,R4 ; *,CHAR 3889 BR 7$ ; 3882 4$: CMP R4,#33 ; CHAR,* 3891 BNE 5$ ADD #11,R4 ; *,CHAR 3892 BR 7$ ; 3882 5$: CMP R4,#34 ; CHAR,* 3894 BEQ 6$ ; 3895 CMP R4,#35 ; CHAR,* 3897 BNE 6$ ADD #42,R4 ; *,CHAR 3898 BR 7$ ; 3882 6$: ADD #22,R4 ; *,CHAR 3901 7$: MOVB R4,(R2)+ ; CHAR,RETURN.ASCII.AD 3905 MOV R5,R1 ; CONTROL,* 3907 SXT R0 DIV #50,R0 MOV R0,R5 ; *,CONTROL DEC (SP) ; I 3861 BNE 1$ 8$: ADD #6,SP ; 3834 MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R1 RTS PC ; Routine Size: 71 words, Routine Base: $CODE$ + 11326 ; Maximum stack depth per invocation: 11 words .NLIST .DSABL LSB .NLIST BIN,LOC .LIST ; 3911 1 ; 3912 1 END ! End of module ; 3913 1 ; 3914 0 ELUDOM .NLIST .LIST BIN,LOC .LIST ; OTS external references .GLOBL $SAVE5, $SAVE3, $SAVE2 .PSECT $OWN$, D .EVEN ; PSECT SUMMARY ; ; Psect Name Words ; Attributes ; $OWN$ 747 ; RW , D , LCL, REL, CON ; $CODE$ 2482 ; RO , I , LCL, REL, CON ; $PLIT$ 100 ; RO , D , LCL, REL, CON ; Library Statistics ; ; -------- Symbols -------- Pages Processing ; File Total Loaded Percent Mapped Time ; ; SYS$COMMON:[SYSLIB]RSX11M.L16;1 1554 5 0 99 00:00.3 ; SYS$COMMON:[SYSLIB]FCS11.L16;1 396 32 8 42 00:00.2 ; Compilation Complete .SBTTL Assign the LUN ; ; This routine is called to assign the LUN. This is a duplication ; of the code in DRASG. DRASG should be moved into the 4th ; directive common so that this code may be common. ; ; ; R3=ADDRESS OF THE LUN IN THE DPB. ; R4=ADDRESS OF THE HEADER OF THE CURRENT TASK. ; R5=ADDRESS OF THE TCB OF THE CURRENT TASK. ; R0=Device name ; R1=Unit number ; R2=Terminal logical flag ; ; Outputs: The address of a routine to call to return status is ; returned in R0 ; ; Directive status of +1 is returned. ; ; Directive status of 'D.RS90' is returned if a file ; is open or unit attached on the specified LUN. ; Directive status of 'D.RS92' is returned if device ; and/or unit is invalid. ;- .PSECT DNAME: .BLKW 1 UNITN: .BLKW 1 TFLAG: .BLKW 1 TUCB: .BLKW 1 LUN.ASSIGN: MOV R0,DNAME ; Save inputs MOV R1,UNITN MOV R2,TFLAG CALL $MPLUN ; Map LUN to device UCB TST (R1) ; File accessed on LUN? BNE 40$ ; If ne yes MOV R0,-(SP) ; Save address of UCB MOV R1,R4 ; Save address of second LUN word MOV DNAME,R2 ; Get name of device MOVB UNITN,R0 ; Get unit number .IF DF M$$MUP BIT #T3.SLV,T.ST3(R5) ; Slave task? BNE 17$ ; If ne yes, bypass logical device table .ENDC TST TFLAG ; BNE 17$ ; Terminal logical name. don't do more ; translations MOV T.UCB(R5),R1 ; Get the current task's ti: CALL $GTUSR MOV #$LNTDR,-(SP) ; Resolve any logical name translations CALL $MPDC3 ; Use routine in third directive common BCC 17$ ; If CC, successfully matched logical TST R3 ; See if error occurred or no match at all BNE 50$ ; If ne, invalid match occurred MOV #$LOGHD,R3 ; Point to logical assignment list 13$: MOV (R3),R3 ; Get address of next entry BEQ 17$ ; If eq end of list TSTB L.TYPE(R3) ; System wide assignment? BEQ 15$ ; If eq yes CMP L.UCB(R3),T.UCB(R5) ; TI: UCB address match? BNE 13$ ; If ne no 15$: CMP R2,L.NAM(R3) ; Device name match? BNE 13$ ; If ne no CMPB R0,L.UNIT(R3) ; Unit number match? BNE 13$ ; If ne no MOV L.ASG(R3),R1 ; Get assignment UCB address BR 25$ ; Finish in common code 17$: MOV #$DEVHD,R3 ; Point to physical device tables 20$: MOV (R3),R3 ; Get address of next DCB BEQ 50$ ; If eq end of tables CMP R2,D.NAM(R3) ; Device name match? BNE 20$ ; If ne no CMPB R0,D.UNIT(R3) ; Unit greater than or equal to low boundary? BLO 20$ ; If lo no CMPB R0,D.UNIT+1(R3) ; Unit less than or equal to high boundary? BHI 20$ ; If hi no SUB D.UNIT(R3),R0 ; Calculate relative unit number BIC #177400,R0 ; Clear excess bits MOV D.UCBL(R3),R1 ; Get length of UCB in bytes CALL $MUL ; Calculate number of bytes ADD D.UCB(R3),R1 ; Calculate address of UCB 25$: ; Ref label .IF DF V$$TRM MOV (R1),R3 ; Point to device DCB CMP D.NAM(R3),#"VT ; Is the device a virtual terminal? BNE 26$ ; If ne no CMP U.PTCB(R1),R5 ; Is issuing task the parent? BEQ 26$ ; If eq no CMP R1,T.UCB(R5) ; Is issuing task an offspring? BNE 50$ ; If ne no .ENDC 26$: MOV (SP)+,R3 ; Was LUN previously assigned? BEQ 30$ ; If EQ no CMP R5,U.ATT(R3) ; Unit attached to current task? BNE 27$ ; If NE no MOV R1,-(SP) ; Save new assignment UCB address MOV R1,R0 ; Copy UCB address CALL $MPLND ; Map to real UCB address MOV (SP)+,R1 ; Retrieve new assignment UCB address CMP R0,R3 ; New assignment to same final UCB? BNE 35$ ; If NE no 27$: MOV R3,R5 ; Copy old assignment UCB address MOV R1,-(R4) ; Assign LUN to new unit MOV R1,TUCB ; Save the UCB address to return CALL $IOKIL CLR R0 ; No bad status to return MOV TUCB,R1 ; Return the UCB address 31$: RETURN ; 30$: MOV R1,-(R4) ; Assign LUN to new unit BR 31$ 35$: MOV R1,-(SP) ; Save new UCB pointer .IF DF X$$HDR MOV $SAHPT,R1 ; Get task header address .IFF MOV $HEADR,R1 ; Get task header address .ENDC ADD #H.NLUN,R1 ; Point to the number of LUNs MOV (R1),-(SP) ; Pick up count 37$: CMP (R1)+,(R1)+ ; Advance to next UCB pointer + 2 CMP R1,R4 ; Same LUN as being reassigned? BEQ 39$ ; If eq yes MOV -2(R1),R0 ; Get this LUN assignment BEQ 39$ ; If eq, LUN not assigned CALL $MPLND ; Follow any redirect; handle ti: CMP R0,R3 ; LUN assigned to same dev as reass LUN? BNE 39$ ; No, branch TST (SP)+ ; Remove count MOV (SP)+,R1 ; Get new LUN assignment BR 27$ ; If eq yes, attach can be ignored 39$: DEC (SP) ; Point to next LUN BGT 37$ ; Try again CMP (SP)+,(SP)+ ; Clean stack 40$: MOV #RS90,R0 ; Status return routine RETURN 50$: TST (SP)+ ; Clean stack MOV #RS92,R0 ; Status return routine RETURN RS90: DRSTS D.RS90 ; Set directive status RS92: DRSTS D.RS92 ; Set directive status .SBTTL Registers save and restore routines for BLISS-16 ; ; Register save and restore routines used by BLISS generated code. ; .PSECT BL$COD,RO,I,LCL,CON $SAVE2: MOV R2,-(SP) MOV R1,-(SP) MOV 4(SP),R1 JSR PC,@(SP)+ BR RE2 $SAVE3: MOV R2,-(SP) MOV R3,-(SP) MOV R1,-(SP) MOV 6(SP),R1 JSR PC,@(SP)+ BR RE3 $SAVE4: MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R1,-(SP) MOV 8.(SP),R1 JSR PC,@(SP)+ BR RE4 $SAVE5: MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) MOV R1,-(SP) MOV 10.(SP),R1 JSR PC,@(SP)+ MOV (SP)+,R5 RE4: MOV (SP)+,R4 RE3: MOV (SP)+,R3 RE2: MOV (SP)+,R2 MOV (SP)+,R1 RTS PC .SBTTL Stub routines to call routines in other directive commons .PSECT ;+ ; $DCBTA - Routine to turn a binary value into an ASCII text string ; ; Inputs: ; R0 - Number to be translated into ASCII ; R3 - Pointer to buffer to store translated number ; ; Outputs: ; R3 - Points past the number string ; ; This routine will not translate a zero unit number into an ASCII digit ; ;- DCBTA.BLI: BIC #177400,R0 ;PREVENT SIGN PROPAG. IN ASH ;(0